diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+Copyright (c) 2009 Christiaan Baaij & Matthijs Kooijman
+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 the copyright holder nor the
+      names of its 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 HOLDER ``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 HOLDER 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/Language/VHDL/AST.hs b/Language/VHDL/AST.hs
new file mode 100644
--- /dev/null
+++ b/Language/VHDL/AST.hs
@@ -0,0 +1,729 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.VHDL.AST
+-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  christiaan.baaij@gmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable (Template Haskell)
+--
+-- A VHDL 93 subset AST (Abstract Syntax Tree), coded so that it can be easy 
+-- to extend, please see doc/VHDL/vhdl93-syntax.html as reference 
+-- in order to extend it (this AST is based on that grammar)
+-----------------------------------------------------------------------------
+
+-- This AST is aimed at code generation not parsing, and thus, 
+-- it was simplified
+-- The incompatibilities or simplifications from the standard
+-- are properly commented
+
+-- FIXME: shouldn't be records used instead of bare algebraic types?
+-- FIXME: shouldn't the unused type redefinitions be removed?
+-- FIXME: It would maybe be a good idea to create a sequence ADT which
+--        guaranteed to hold at least one element (i.e. the grammar
+--        has some cases such as "choices ::= choice | {choice}"
+--        which are not well represented as "[Choice]", 
+--        "Choices Choice  (Maybe [Choice])" is not easy to handle either
+--        and thus, it was discarded.
+
+module Language.VHDL.AST where
+
+import Data.Char (toLower)
+import Text.Regex.Posix
+
+import Language.VHDL.Error
+
+
+--------------------
+-- VHDL identifiers
+--------------------
+
+-- VHDL identifier, use mkVHDLId to create it from a String, 
+-- making sure a string is a proper VHDL identifier
+data VHDLId = Basic String | Extended String
+ deriving Eq
+
+-- | Obtain the String of a VHDL identifier
+fromVHDLId :: VHDLId -> String
+fromVHDLId (Basic    str) = str
+fromVHDLId (Extended str) = '\\' :  (escapeBackslashes str) ++ "\\"
+ where escapeBackslashes [] = []
+       escapeBackslashes (x : xs) 
+        | x == '\\' = "\\\\" ++ escapeBackslashes xs
+        | otherwise = x : escapeBackslashes xs
+instance Show VHDLId where
+ show  = show.fromVHDLId
+
+
+-- | unsafely create a basic VHDLId (without cheking if the string is correct)
+unsafeVHDLBasicId :: String -> VHDLId
+unsafeVHDLBasicId str = Basic str
+
+
+-- | unsafely create an exteded VHDLId (without cheking if the string is 
+--   correct)
+unsafeVHDLExtId :: String -> VHDLId
+unsafeVHDLExtId str = Extended str
+
+
+-- | Create a VHDL basic identifier from a String, previously checking if the  
+--   String is correct
+mkVHDLBasicId ::String -> EProne VHDLId
+-- FIXME: we relax the fact that two consecutive underlines 
+--        are not allowed
+mkVHDLBasicId [] = throwError EmptyVHDLId
+mkVHDLBasicId id
+  | id =~ basiIdPat && (not $ elem lowId reservedWords) = return $ Basic id
+  | otherwise = throwError $ IncVHDLBasId id
+ where lowId = map toLower id
+       basiIdPat = "^[A-Za-z](_?[A-Za-z0-9])*$"
+
+-- | Create a VHDL extended identifier from a String, previously checking 
+--   if the String is correct. The input string must not include the initial
+--   and ending backslashes nad the intermediate backslashes shouldn't be escaped.
+mkVHDLExtId :: String -> EProne VHDLId
+mkVHDLExtId [] = throwError EmptyVHDLId
+mkVHDLExtId id
+ | id =~ extIdPat = return $ Extended id
+ | otherwise = throwError $ IncVHDLExtId id
+ where -- Regular expression pattern for extended identifiers.
+       -- According to the VHDL93 standard, an extended identifier must:
+       --  * Start and end with a backslash '\'
+       --  * Its middle characters can be
+       --    * two contiguous backslashes \\
+       --    * an alphanumeric (A-Za-z0-9)
+       --    * a Special Character 
+       --    * an Other Special Character 
+       --      (backslashes can only appear in pairs as indicated above)
+       -- 
+       -- However, backslashes will be handled when printing the identifier,
+       -- (an initial and ending backslash are added and the intermediate backslashes
+       --  are escaped)
+       --
+       -- Note that we cannot use specialChars and otherSpecialChars
+       -- to build the pattern because of the double-backslash rule
+       -- and also, the right bracket (according to the posix
+       -- standard) needs to go in the first place of a bracket
+       -- expression to lose its special meaning.  Furthermore,
+       -- (according to the POSIX standard as well) we also need to put
+       -- '-' in the last place of the bracket expression.
+   extIdPat = 
+     "^[]A-Za-z0-9 \"#&\\'()*+,./:;<=>_|!$%@?[^`{}~-]+$"
+
+
+-- | Unsafely append a string to a VHDL identifier (i.e. without checking if
+--  the resulting identifier is valid)
+unsafeIdAppend :: VHDLId -> String -> VHDLId
+unsafeIdAppend (Basic id)    suffix = Basic $ id ++ suffix
+unsafeIdAppend (Extended id) suffix = Extended $ id ++ suffix
+
+-- | special characters as defined in the VHDL93 standard
+specialChars :: [Char]
+specialChars = ['"' , '#' , '&' , '\'' , '(' , ')' , '*' , '+' , ',',
+                '-' , '.' , '/' , ':'  , ';' , '<' , '=' , '>' , '_' , '|']
+
+-- | other special characters as defined in the VHDL93 standard
+otherSpecialChars :: [Char]
+otherSpecialChars =['!' , '$' , '%' , '@' , '?' , '[' , '\\' , ']',
+                    '^' , '`' , '{' , '}' , '~']
+
+-- | Reserved identifiers
+reservedWords :: [String]
+reservedWords = ["abs", "access", "after", "alias", "all", "and",
+ "architecture", "array", "assert", "attribute", "begin", "block",
+ "body", "buffer", "bus", "case", "component", "configuration",
+ "constant", "disconnect", "downto", "else", "elsif", "end", "entity",
+ "exit", "file", "for", "function", "generate", "generic", "group",
+ "guarded", "if", "impure", "in", "inertial", "inout", "is", "label",
+ "library", "linkage", "literal", "loop", "map", "mod", "nand", "new",
+ "next", "nor", "not", "null", "of", "on", "open", "or", "others",
+ "out", "package", "port", "postponed", "procedure", "process", "pure",
+ "range", "record", "register", "reject", "rem", "report", "return",
+ "rol", "ror", "select", "severity", "shared", "signal", "sla", "sll",
+ "sra", "srl", "subtype", "then", "to", "transport", "type",
+ "unaffected", "units", "until", "use", "variable", "wait", "when",
+ "while", "with", "xnor", "xor"]
+
+
+
+
+   ---------
+   -- AST --
+   ---------
+
+
+-- { } (0 or more) is expressed as [ ]
+-- [ ] (optional) is expressed as Maybe
+
+
+-- design_file
+-- Having ContextClauses associated to library units is messy
+-- instead we only allow ContextClause for the whole design file.
+-- Furthermore we incorrectly (and deliberately) accept a file with 
+-- no library units 
+data DesignFile = DesignFile [ContextItem] [LibraryUnit]  
+ deriving Show
+
+-- context_item
+-- We don't allow the "name1,name2,name3" syntax, only one name is allowed
+--  at once
+data ContextItem = Library VHDLId | Use SelectedName
+ deriving Show
+
+-- library_unit
+-- We avoid adding the overhead of a PrimaryUnit and SecondaryUnit types
+data LibraryUnit = LUEntity EntityDec      | 
+                   LUArch ArchBody         | 
+                   LUPackageDec PackageDec |
+                   LUPackageBody PackageBody
+ deriving Show
+
+-- entity_declaration
+-- No declarative nor statemet part is allowed 
+-- Only interface signal declarations are allowed in the port clause
+data EntityDec = EntityDec VHDLId [IfaceSigDec]
+ deriving Show
+
+-- | interface_signal_declaration
+-- We don't allow the "id1,id2,id3" syntax, only one identifier is allowed
+--  at once
+-- The Mode is mandatory
+-- Bus is not allowed 
+-- Preasigned values are not allowed
+-- Subtype indications are not allowed, just a typemark 
+-- Constraints are not allowed: just add a new type with the constarint
+--  in ForSyDe.vhd if it is required
+data IfaceSigDec = IfaceSigDec VHDLId Mode TypeMark
+ deriving Show
+
+-- | type_mark
+-- We don't distinguish between type names and subtype names
+-- We dont' support selected names, only simple names because we won't need
+-- name selection (i.e. Use clauses will make name selection unnecesary)
+type TypeMark = SimpleName
+
+
+-- | mode
+-- INOUT | BUFFER | LINKAGE are not allowed
+data Mode = In | Out
+ deriving (Show, Eq)
+
+-- | architecture_body 
+-- [ ARCHITECTURE ] and [ architecture_simple_name ] are not allowed
+data ArchBody = ArchBody VHDLId VHDLName [BlockDecItem] [ConcSm]
+ deriving Show
+
+-- | package_declaration
+--  [ PACKAGE ] and [ package_simple_name ] are not allowed
+data PackageDec = PackageDec VHDLId [PackageDecItem]
+ deriving Show
+
+
+-- | package_declarative_item
+-- only type declarations, subtype declarations and subprogram specifications 
+-- (working as subprogram_declaration) allowed
+data PackageDecItem = PDITD TypeDec | PDISD SubtypeDec | PDISS SubProgSpec
+ deriving Show
+
+-- | package_body
+--  [ PACKAGE ] and [ package_simple_name ] are not allowed
+data PackageBody = PackageBody VHDLId [PackageBodyDecItem]
+ deriving Show
+
+-- | only subprogram_body is allowed
+type PackageBodyDecItem = SubProgBody
+
+-- | subtype-declaration
+data SubtypeDec = SubtypeDec VHDLId SubtypeIn
+ deriving Show
+
+-- | subtype_indication
+--   resolution functions are not permitted
+data SubtypeIn = SubtypeIn TypeMark (Maybe SubtypeConstraint)
+ deriving Show
+
+-- | constraint
+-- Only index constraints are allowed
+type Constraint = IndexConstraint
+
+data SubtypeConstraint = ConstraintIndex Constraint | ConstraintRange Range
+ deriving Show
+
+-- | range
+--   the direction must always be \"to\"
+data Range =  AttribRange AttribName | 
+              SubTypeRange Expr Expr |
+              ToRange Expr Expr      |
+              DownRange Expr Expr 
+ deriving Show
+
+-- | index_constraint
+data IndexConstraint = IndexConstraint [DiscreteRange]
+ deriving Show
+
+-- | discrete_range
+--   only ranges are allowed
+type DiscreteRange = Range
+
+-- | type_declaration
+-- only full_type_declarations are allowed
+data TypeDec = TypeDec VHDLId TypeDef
+ deriving Show
+
+-- | type_declaration
+-- only composite types and enumeration types (a specific scalar type)
+data TypeDef = TDA ArrayTypeDef | TDR RecordTypeDef | TDE EnumTypeDef
+ deriving Show
+
+-- | array_type_definition
+--     unconstrained_array_definition
+--     constrained_array_definition
+-- A TypeMark is used instead of a subtype_indication. If subtyping is required,
+-- declare a subtype explicitly.  
+data ArrayTypeDef = UnconsArrayDef [TypeMark] TypeMark |
+                    ConsArrayDef IndexConstraint TypeMark
+ deriving Show
+
+-- | record_type_definition
+-- [ record_type_simple_name ] not allowed
+data RecordTypeDef = RecordTypeDef [ElementDec]
+ deriving Show
+
+-- | element_declaration 
+-- multi-identifier element declarations not allowed
+-- element_subtype_definition is simplified to a type_mark
+data ElementDec = ElementDec VHDLId TypeMark
+ deriving Show
+
+-- | enumeration_type_definition 
+--   enumeration literals can only be identifiers
+data EnumTypeDef = EnumTypeDef [VHDLId]
+ deriving Show
+
+-- | name
+-- operator_names are not allowed 
+data VHDLName = NSimple SimpleName     | 
+                NSelected SelectedName | 
+                NIndexed IndexedName   |
+                NSlice SliceName       |
+                NAttribute AttribName 
+ deriving Show
+
+-- | simple_name
+type SimpleName = VHDLId
+
+-- | selected_name
+data SelectedName = Prefix :.: Suffix
+ deriving Show
+
+infixl :.:
+
+-- | indexed_name
+-- note that according to the VHDL93 grammar the index list cannot be empty 
+data IndexedName = IndexedName Prefix [Expr]
+ deriving Show
+
+-- | prefix
+--  only names (no function calls)
+type Prefix = VHDLName
+
+-- | suffix
+-- no character or operator symbols are accepted
+data Suffix = SSimple SimpleName | All
+ deriving Show
+
+
+-- | slice_name
+data SliceName = SliceName Prefix DiscreteRange
+ deriving Show
+
+-- | attribute_name
+--   signatures are not allowed
+data AttribName = AttribName Prefix VHDLName (Maybe Expr)
+ deriving Show
+
+-- | block_declarative_item
+-- Only subprogram bodies and signal declarations are allowed
+data BlockDecItem = BDISPB SubProgBody | BDISD SigDec
+ deriving Show
+
+
+-- | subprogram_body
+-- No subprogram kind nor designator is allowed
+data SubProgBody = SubProgBody SubProgSpec [SubProgDecItem] [SeqSm]
+ deriving Show
+
+-- | subprogram_declarative_item
+--   only varaible declarations are allowed.
+data SubProgDecItem = SPVD VarDec | SPCD ConstDec | SPSB SubProgBody
+ deriving Show
+
+-- | variable_declaration
+--   identifier lists are not allowed
+data VarDec = VarDec VHDLId SubtypeIn (Maybe Expr)
+ deriving Show
+
+data ConstDec = ConstDec VHDLId SubtypeIn (Maybe Expr)
+ deriving Show
+
+-- | subprogram_specification
+-- Only Functions are allowed
+-- [Pure | Impure] is not allowed
+-- Only an identifier is valid as the designator
+-- In the formal parameter list only variable declarations are accepted  
+data SubProgSpec = Function VHDLId [IfaceVarDec] TypeMark 
+ deriving Show
+
+-- | interface_variable_declaration
+-- [variable] is not allowed
+-- We don't allow the "id1,id2,id3" syntax, only one identifier is allowed
+-- Mode is not allowed
+-- Resolution functions and constraints are not allowed, thus a TypeMark
+--  is used instead of a subtype_indication. If subtyping is required,
+--  declare a subtype explicitly.
+data IfaceVarDec = IfaceVarDec VHDLId TypeMark
+ deriving Show
+
+-- | sequential_statement
+-- Only If, case, return, for loops, assignment, @wait for@ procedure calls
+-- allowed.
+-- Only for loops are allowed (thus loop_statement doesn't exist) and cannot
+-- be provided labels.
+-- The target cannot be an aggregate.
+-- General wait statements are not allowed, only @wait for@
+-- It is incorrect to have an empty [CaseSmAlt]
+data SeqSm = IfSm  Expr [SeqSm] [ElseIf] (Maybe Else) |
+             CaseSm Expr [CaseSmAlt]                  |
+             ReturnSm (Maybe Expr)                    |
+             ForSM VHDLId DiscreteRange [SeqSm]       |
+             VHDLName := Expr                         |
+             WaitFor Expr                             |
+             SigAssign  VHDLName Wform                |
+             ProcCall VHDLName [AssocElem]
+ deriving Show
+
+-- | helper type, they doesn't exist in the origianl grammar
+data ElseIf = ElseIf Expr [SeqSm]
+ deriving Show
+
+-- | helper type, it doesn't exist in the origianl grammar
+data Else = Else [SeqSm]
+ deriving Show
+
+-- | case_statement_alternative
+-- it is incorrect to have an empty [Choice]
+data CaseSmAlt = CaseSmAlt [Choice] [SeqSm]
+ deriving Show
+
+-- | choice
+-- although any expression is allowed the grammar specfically only allows 
+-- simple_expressions (not covered in this AST) 
+data Choice = ChoiceE Expr | Others
+ deriving Show
+
+-- | signal_declaration
+-- We don't allow the "id1,id2,id3" syntax, only one identifier is allowed
+--  at once
+-- Resolution functions and constraints are not allowed, thus a TypeMark
+--  is used instead of a subtype_indication
+-- Signal kinds are not allowed
+data SigDec = SigDec VHDLId TypeMark (Maybe Expr)
+ deriving Show
+
+-- | concurrent_statement
+-- only block statements, component instantiations and signal assignments 
+-- are allowed
+data ConcSm = CSBSm BlockSm | 
+              CSSASm  ConSigAssignSm | 
+              CSISm CompInsSm  |
+              CSPSm ProcSm |
+              CSGSm GenerateSm
+ deriving Show
+
+-- | block_statement
+-- Generics are not supported
+-- The port_clause (with only signals) and port_map_aspect are mandatory
+-- The ending [ block_label ] is not allowed
+-- 
+data BlockSm = BlockSm Label [IfaceSigDec] PMapAspect [BlockDecItem] [ConcSm]
+ deriving Show
+
+-- | port_map_aspect
+newtype PMapAspect = PMapAspect [AssocElem]
+ deriving Show
+
+-- | label
+type Label = VHDLId
+
+-- | association_element
+data AssocElem = Maybe (FormalPart) :=>: ActualPart
+ deriving Show
+
+-- | formal_part
+-- We only accept a formal_designator (which is a name after all),
+-- in the forme of simple name (no need for selected names)   
+--  "function_name ( formal_designator )" and "type_mark ( formal_designator )"
+--  are not allowed
+type FormalPart = SimpleName
+
+-- | actual_part
+-- We only accept an actual_designator,
+--  "function_name ( actual_designator )" and "type_mark ( actual_designator )"
+--  are not allowed
+type ActualPart = ActualDesig
+
+-- | actual_designator
+data ActualDesig = ADName VHDLName | ADExpr Expr | Open
+ deriving Show
+
+-- | concurrent_signal_assignment_statement
+-- Only conditional_signal_assignment is allowed (without options)
+-- The LHS (targets) are simply signal names, no aggregates
+data ConSigAssignSm = VHDLName :<==: ConWforms
+ deriving Show
+
+-- | conditional_waveforms 
+data ConWforms = ConWforms [WhenElse] Wform (Maybe When)  
+ deriving Show
+
+-- | Helper type, it doesn't exist in the VHDL grammar
+data WhenElse = WhenElse Wform Expr
+ deriving Show
+
+-- | Helper type, it doesn't exist in the VHDL grammar
+newtype When = When Expr
+ deriving Show
+
+-- | waveform
+-- although it is possible to leave [Expr] empty, that's obviously not
+-- valid VHDL waveform
+data Wform = Wform [WformElem] | Unaffected
+ deriving Show
+
+-- | waveform_element
+--   Null is not accepted
+data WformElem = WformElem Expr (Maybe Expr)
+ deriving Show
+
+           
+-- | component_instantiation_statement
+-- No generics supported
+-- The port map aspect is mandatory
+data CompInsSm = CompInsSm Label InsUnit PMapAspect
+ deriving Show
+
+-- | process_statement
+--   The label is mandatory
+--   Only simple names are accepted in the sensitivity list
+--   No declarative part is allowed
+data ProcSm = ProcSm Label [SimpleName] [SeqSm]
+ deriving Show
+
+-- | instantiated_unit
+-- Only Entities are allowed and their architecture cannot be specified
+data InsUnit = IUEntity VHDLName
+ deriving Show
+
+data GenerateSm = GenerateSm Label GenSm [BlockDecItem] [ConcSm]
+  deriving Show
+
+data GenSm = ForGn VHDLId DiscreteRange |
+             IfGn  Expr
+  deriving Show
+
+-----------------
+-- Expression AST
+-----------------
+
+-- | expression, instead of creating an AST like the grammar 
+-- (see commented section below) we made our own expressions which are 
+-- easier to handle, but which don't don't show operand precedence
+-- (that is a responsibility of the pretty printer)
+
+data Expr = -- Logical operations
+            And  Expr Expr    |
+            Or   Expr Expr    |
+            Xor  Expr Expr    |
+            Nand Expr Expr    |
+            Nor  Expr Expr    |
+            Xnor Expr Expr    |
+            -- Relational Operators
+            Expr :=:  Expr    |
+            Expr :/=: Expr    |
+            Expr :<:  Expr    |
+            Expr :<=: Expr    |
+            Expr :>:  Expr    |
+            Expr :>=: Expr    |
+            -- Shift Operators
+            Sll Expr Expr     |
+            Srl Expr Expr     |
+            Sla Expr Expr     |
+            Sra Expr Expr     |
+            Rol Expr Expr     |
+            Ror Expr Expr     |
+            -- Adding Operators
+            Expr :+: Expr     |
+            Expr :-: Expr     |
+            Expr :&: Expr     |
+            -- Sign Operators
+            Neg Expr          |
+            Pos Expr          |
+            -- Multiplying Operators
+            Expr :*: Expr     |
+            Expr :/: Expr     |
+            Mod  Expr Expr    |
+            Rem  Expr Expr    |
+            -- Miscellaneous Operators
+            Expr :**: Expr    |
+            Abs  Expr         |
+            Not  Expr         |
+            -- Primary expressions
+            -- Only literals, names and function calls  are allowed
+            PrimName VHDLName |
+            PrimLit   Literal |
+            PrimFCall FCall   |       
+            -- Composite_types-related operators
+            Aggregate [ElemAssoc]   -- (exp1,exp2,exp3, ...)
+ deriving Show            
+
+-- operand precedences, according to the VHDL LRM: 
+--  "Where the language
+--   allows a sequence of operators, operators with the same
+--   precedence level are associated with their operands in textual
+--   order, from left to right." In other words, they are all left associative
+--
+--   For example: a / b / c    = (a/b)/c
+--                a and b or c  is illegal (mixing operators is not allowed
+--                                          by the language and only
+--                                          can avoid parenthesis in some 
+--                                          cases)
+
+infixl 2 `And`, `Or`, `Xor`, `Nand`, `Nor`, `Xnor`
+infixl 3 :=:, :/=:, :<:, :<=:, :>:, :>=:
+infixl 4 `Sll`, `Srl`, `Sla`, `Sra`, `Rol`, `Ror`
+infixl 5 :+:, :-:, :&:
+infix  6 `Neg`, `Pos`  
+infixl 7 :*:, :/:, `Mod`, `Rem`
+infixl 8 :**:, `Abs`,  `Not` 
+
+-- | Logical Operators precedence
+logicalPrec :: Int
+logicalPrec = 2
+
+-- | Relational Operators Precedence
+relationalPrec :: Int
+relationalPrec = 3
+
+-- | Shift Operators Precedence
+shiftPrec :: Int
+shiftPrec = 4
+
+-- | Plus Operators precedence
+plusPrec :: Int
+plusPrec = 5
+
+-- | Sign Operators Precedence
+signPrec :: Int
+signPrec = 6
+
+-- | Multplying Operators Precedecne
+multPrec :: Int
+multPrec = 7
+
+-- | Miscellaneous Operators Precedence
+miscPrec :: Int
+miscPrec = 8
+
+
+
+
+-- | element_association
+--   only one choice is allowed
+data ElemAssoc = ElemAssoc (Maybe Choice) Expr
+ deriving Show
+
+-- | literal
+-- Literals are expressed as a string (remember we are generating
+-- code, not parsing)
+type Literal = String
+
+-- | function_call
+data FCall = FCall VHDLName [AssocElem]
+ deriving Show
+             
+            
+{-
+
+Expression AST following the grammar (discarded)
+
+-- again, even if it possible to leave the [Relation] lists empty
+-- that wouldn't be valid VHDL code
+-- regading  NandExpr and NorExpr, their Relation list should 
+-- have a maximum size of two (i.e. NandExpr Expr (Maybe Expr))
+data Expr = AndExpr  [Relation] | 
+            OrExpr   [Relation] |
+            XorExpr  [Relation] |
+            NandExpr [Relation] |
+            NorExpr  [Relation] |
+            XnorExpr [Relation]
+ deriving Show
+
+-- relation            
+data Relation = Relation ShiftExpr  (Maybe (RelOp,ShiftExpr))
+ deriving Show
+
+-- relational_operator
+data RelOp = Eq | NEq | Less | LessEq | Gter | GterEq 
+ deriving Show 
+
+-- shift_expression
+data ShiftExpr = ShiftExpr SimpleExpr (Maybe(ShiftOp,SimpleExpr)) 
+ deriving Show
+
+-- simple_expression
+data SimpleExpr = SimpleExpr (Maybe Sign) Term [(AddOp,Term)]
+ deriving Show
+
+-- sign
+data Sign = Pos | Neg
+ deriving Show
+
+-- shift_operator
+data ShiftOp = Sll | Srl | Sla | Sra | Rol | Ror
+ deriving Show 
+
+-- adding_operator
+data AddOp = Plus | Minus | Concat 
+ deriving Show
+
+-- term
+data Term = Term Factor (Maybe (MultOp, Factor))
+ deriving Show
+
+-- multiplying_operator
+data MultOp = Mult | Div | Mod | Rem
+ deriving Show
+
+-- factor
+data Factor = Exp Primary (Maybe (Primary)) |
+              Abs Primary                   |
+              Not Primary
+ deriving Show
+
+-- primary
+-- Only literals, names and function calls  are allowed
+data Primary = PrimName  VHDLName    |
+               PrimLit   Literal |
+               PrimFCall FCall
+ deriving Show
+
+-- literal
+-- Literals are expressed as a string (remember we are generating
+-- code, not parsing)
+type Literal = String
+
+-- function_call
+data FCall = FCall VHDLName [AssocElem]
+ deriving Show
+-}
diff --git a/Language/VHDL/AST/Ppr.hs b/Language/VHDL/AST/Ppr.hs
new file mode 100644
--- /dev/null
+++ b/Language/VHDL/AST/Ppr.hs
@@ -0,0 +1,504 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.VHDL.AST.Ppr
+-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  christiaan.baaij@gmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable (Template Haskell)
+--
+-- VHDL pretty-printing instances.
+--
+-----------------------------------------------------------------------------
+
+
+-- FIXME:  we could avoid the LANGUAGE extensions by adding ppr_list to the Ppr 
+--         class (see Language.Haskell.TH.Ppr)
+
+module Language.VHDL.AST.Ppr () where
+
+import Language.VHDL.Ppr
+
+import Language.VHDL.AST
+
+import Text.PrettyPrint.HughesPJ hiding (Mode)
+
+
+-- | Number of spaces used for indentation
+nestVal :: Int
+nestVal = 5
+
+instance Ppr a => Ppr (Maybe a) where
+ ppr (Just a) = ppr a
+ ppr Nothing  = empty 
+
+instance (Ppr a, Ppr b) => Ppr (a,b) where
+ ppr (a,b) = ppr a <+> ppr b
+
+instance Ppr VHDLId where
+ ppr = text.fromVHDLId
+ 
+
+instance Ppr DesignFile where
+ ppr (DesignFile cx lx) = vNSpaces spaces (ppr_list ($+$) cx) 
+                                          (ppr_list (vNSpaces spaces) lx)  $+$
+                          vSpace
+  where spaces = 2
+
+
+        
+instance Ppr ContextItem where
+ ppr (Library id) = text "library" <+> ppr id <> semi
+ ppr (Use name) = text "use" <+> ppr name <> semi
+ 
+
+instance Ppr LibraryUnit where
+ ppr (LUEntity entityDec) = ppr entityDec
+ ppr (LUArch archBody)  = ppr archBody
+ ppr (LUPackageDec packageDec) = ppr packageDec 
+ ppr (LUPackageBody packageBody) = ppr packageBody
+
+instance Ppr EntityDec where
+ ppr (EntityDec id ifaceSigDecs) = 
+  text "entity" <+> idDoc <+> text "is" $+$
+     nest nestVal (ppr ifaceSigDecs) $+$
+  text "end entity" <+> idDoc <> semi
+  where idDoc = ppr id  
+
+instance Ppr [IfaceSigDec] where
+-- FIXME: improve pretty printing of the
+--        declarations
+-- This:
+-- S1 : bit
+-- Ssdds : bit
+-- should really be printed as
+-- S1    : bit
+-- Ssdds : bit
+ ppr []   = empty
+ ppr decs = text "port" <+> (parens (ppr_list vSemi decs) <> semi)
+
+
+instance Ppr IfaceSigDec where
+ ppr (IfaceSigDec id mode typemark) = 
+   ppr id <+> colon <+> ppr mode <+> ppr typemark
+
+
+instance Ppr Mode where
+ ppr In  = text "in"
+ ppr Out = text "out"
+
+instance Ppr ArchBody where
+ ppr (ArchBody id enName decs conSms) = 
+  text "architecture" <+> idDoc <+> text "of" <+> ppr enName <+> text "is" $+$
+    nest nestVal (ppr decs) $+$
+  text "begin" $+$
+    nest nestVal (ppr_list (vNSpaces 1) conSms) $+$
+  text "end architecture" <+> idDoc <> semi
+  where idDoc = ppr id
+
+instance Ppr PackageDec where
+ ppr (PackageDec id decs) =
+  text "package" <+> idDoc <+> text "is" $+$
+   vSpace $++$
+   nest nestVal (ppr_list (vNSpaces 1) decs) $++$
+   vSpace $+$
+  text "end package" <+> idDoc <> semi
+  where idDoc = ppr id 
+
+instance Ppr PackageDecItem where
+ ppr (PDITD typeDec) = ppr typeDec
+ ppr (PDISD subtypeDec) = ppr subtypeDec
+ ppr (PDISS subProgSpec) = ppr subProgSpec <> semi
+
+instance Ppr PackageBody where
+ ppr (PackageBody id decs) =
+  text "package body" <+> idDoc <+> text "is" $+$
+   vSpace $++$
+   nest nestVal (ppr_list (vNSpaces 1) decs) $++$
+   vSpace $+$
+  text "end package body" <+> idDoc <> semi
+  where idDoc = ppr id 
+
+instance Ppr SubtypeDec where
+ ppr (SubtypeDec id si) = text "subtype" <+> ppr id <+> text "is" <+> ppr si <> semi
+
+instance Ppr SubtypeIn where
+ ppr (SubtypeIn tm mCons) = ppr tm <+> (ppr mCons)
+ 
+instance Ppr SubtypeConstraint where
+ ppr (ConstraintIndex dr) = ppr dr
+ ppr (ConstraintRange dr) = ppr dr
+
+instance Ppr Range  where
+ ppr (AttribRange an) = ppr an
+ ppr (SubTypeRange exp1 exp2) = text "range" <+> ppr exp1 <+> text "to" <+> ppr exp2
+ ppr (ToRange exp1 exp2) = ppr exp1 <+> text "to" <+> ppr exp2
+ ppr (DownRange exp1 exp2) = ppr exp1 <+> text "downto" <+> ppr exp2
+
+
+instance Ppr IndexConstraint where
+ ppr (IndexConstraint dr) = parens (ppr_list hComma dr)
+ 
+
+instance Ppr TypeDec where
+ ppr (TypeDec id typeDef) = 
+  hang (text "type" <+> ppr id <+> text "is") nestVal (ppr typeDef <> semi)
+
+instance Ppr TypeDef where
+ ppr (TDA arrayTD) = ppr arrayTD
+ ppr (TDR recordTD) = ppr recordTD
+ ppr (TDE enumTD) = ppr enumTD
+
+instance Ppr ArrayTypeDef where
+ ppr (UnconsArrayDef unconsIxs elemsTM) = 
+   text "array" <+> parens (ppr_list hComma $ map pprUnconsRange unconsIxs) <+>
+    text "of" <+> ppr elemsTM
+  where pprUnconsRange tm = ppr tm <+> text "range <>"
+
+ ppr (ConsArrayDef consIxs elemsTM) = 
+  text "array" <+> ppr consIxs <+> text "of" <+> ppr elemsTM 
+
+instance Ppr RecordTypeDef where
+ ppr (RecordTypeDef elementDecs) =
+  text "record" <+> (ppr_list ($+$) elementDecs) $+$ 
+  text "end record"
+
+instance Ppr ElementDec where
+ ppr (ElementDec id tm) = ppr id <+> colon <+> ppr tm <> semi 
+
+instance Ppr EnumTypeDef where
+ ppr (EnumTypeDef ids) = lparen <> ppr_list hComma ids <> rparen
+
+instance Ppr VHDLName where
+ ppr (NSimple simple) = ppr simple
+ ppr (NSelected selected) = ppr selected
+ ppr (NIndexed indexed) = ppr indexed
+ ppr (NSlice slice) = ppr slice 
+ ppr (NAttribute attrib) = ppr attrib
+
+instance Ppr SelectedName where
+ ppr (prefix :.: suffix) = ppr prefix <> dot <> ppr suffix
+
+instance Ppr Suffix where
+ ppr (SSimple simpleName) = ppr simpleName
+ ppr All = text "all"
+
+instance Ppr IndexedName where
+ ppr (IndexedName prefix indexList) = 
+  ppr prefix <> parens ( ppr_list hComma indexList )
+
+instance Ppr SliceName where
+ ppr (SliceName prefix discreteRange) = ppr prefix <> parens (ppr discreteRange)
+
+instance Ppr AttribName where
+ ppr (AttribName prefix simpleName mExpr) = 
+   ppr prefix <> char '\'' <> ppr simpleName <> parensNonEmpty (ppr mExpr)
+
+instance Ppr [BlockDecItem] where
+ ppr = ppr_list ($+$)
+
+instance Ppr BlockDecItem where
+ ppr (BDISPB subProgBody) = ppr subProgBody
+ ppr (BDISD  sigDec)      = ppr sigDec
+
+
+instance Ppr SubProgBody where
+ ppr (SubProgBody subProgSpec decItems statements) = 
+  ppr subProgSpec <+> text "is" $+$
+    nest nestVal (ppr_list ($+$) decItems) $+$
+  text "begin" $+$
+    nest nestVal  (ppr_list ($+$) statements) $+$
+-- TODO, show the id here
+  text "end" <> semi
+
+
+instance Ppr SubProgDecItem where
+ ppr (SPVD vd) = ppr vd
+ ppr (SPCD cd) = ppr cd
+ ppr (SPSB sb) = ppr sb
+
+instance Ppr VarDec where
+ ppr (VarDec id st mExpr) = 
+    text "variable" <+> ppr id <+> colon <+> ppr st <+>
+                        (text ":=" <++>  ppr mExpr) <> semi
+
+instance Ppr ConstDec where
+ ppr (ConstDec id st mExpr) =
+   text "constant" <+> ppr id <+> colon <+> ppr st <+>
+                       (text ":=" <++> ppr mExpr) <> semi
+
+instance Ppr SubProgSpec where
+-- FIXME: improve pretty printing of the
+--        declarations
+-- This:
+-- (S1 : bit;
+--  Ssdds : bit)
+-- should really be printed as
+-- (S1    : bit;
+--  Ssdds : bit)
+ ppr (Function name decList returnType) =
+    text "function"  <+> ppr name  <+> (parensNonEmpty (ppr_decs decList) $+$
+                                        text "return" <+> ppr returnType)
+   where ppr_decs ds = ppr_list vSemi ds
+
+         
+
+instance Ppr IfaceVarDec where
+ ppr (IfaceVarDec id typemark) = ppr id <+> colon <+> ppr typemark
+
+instance Ppr SeqSm where
+ ppr (IfSm  cond sms elseIfs maybeElse) = 
+   text "if" <+> ppr cond <+> text "then" $+$
+       nest nestVal (ppr sms) $+$
+   ppr elseIfs $+$
+   ppr maybeElse $+$
+   text "end if" <> semi
+ ppr (CaseSm patern alts) = text "case" <+> ppr patern <+> text "is" $+$
+                               nest nestVal (ppr alts) $+$
+                            text "end case" <> semi
+ ppr (ReturnSm maybeExpr) = text "return" <+> ppr maybeExpr <> semi
+ ppr (ForSM id dr sms) = 
+   text "for" <+> ppr id <+> text "in" <+> ppr dr <+> text "loop" $+$
+     nest nestVal (ppr sms) $+$
+   text "end loop" <> semi
+ ppr (target := orig) = ppr target <+> text ":=" <+> ppr orig <> semi
+ ppr (WaitFor expr) = text "wait for" <+> ppr expr <> semi
+ ppr (targ `SigAssign` orig) = ppr targ <+> text "<=" <+> ppr orig <> semi
+ ppr (ProcCall name assocs) = 
+   ppr name <> parensNonEmpty (commaSep assocs) <> semi
+
+instance Ppr [SeqSm] where
+ ppr = ppr_list ($+$)
+
+instance Ppr [ElseIf] where
+ ppr = ppr_list ($+$)
+
+instance Ppr ElseIf where
+ ppr (ElseIf cond sms) = text "elsif" <+> ppr cond <+> text "then" $+$
+                            nest nestVal (ppr sms)
+
+instance Ppr Else where
+ ppr (Else sms) = text "else" $+$
+                     nest nestVal (ppr sms)
+
+
+instance Ppr [CaseSmAlt] where
+ ppr = ppr_list ($+$)
+
+instance Ppr Choice where
+ ppr (ChoiceE expr) = ppr expr
+ ppr Others         = text "others" 
+
+instance Ppr CaseSmAlt where
+ ppr (CaseSmAlt alts sms) = 
+    text "when" <+> ppr_list joinAlts alts <+> text "=>" $+$
+       nest nestVal (ppr sms)
+  where joinAlts a1 a2 = a1 <+> char '|' <+> a2
+
+instance Ppr SigDec where
+ ppr (SigDec id typemark mInit) = 
+   text "signal" <+> ppr id <+> colon <+> ppr typemark <+> 
+                    (text ":=" <++>  ppr mInit) <> semi
+
+instance Ppr [ConcSm] where
+ ppr = ppr_list ($$)
+  
+instance Ppr ConcSm where
+ ppr (CSBSm blockSm) = ppr blockSm
+ ppr (CSSASm conSigAssignSm) = ppr conSigAssignSm
+ ppr (CSISm compInsSm) = ppr compInsSm
+ ppr (CSPSm procSm) = ppr procSm
+ ppr (CSGSm generateSm) = ppr generateSm
+
+instance Ppr BlockSm where
+ ppr (BlockSm label ifaceSigDecs pMapAspect blockDecItems concSms) =
+   labelDoc <+> colon <+> text "block" $+$
+              nest nestVal (ppr ifaceSigDecs)          $+$
+              nest nestVal (ppr pMapAspect) <++> semi  $+$
+              nest nestVal (ppr blockDecItems)         $+$
+       text "begin" $+$
+              nest nestVal (ppr concSms) $+$
+       text "end block" <+> labelDoc <> semi
+  where labelDoc = ppr label
+   
+instance Ppr GenerateSm where
+ ppr (GenerateSm label generation_scheme blockDecItems concSms) =
+   labelDoc <+> colon <+> (ppr generation_scheme) <+> text "generate" $+$
+              nest nestVal (ppr blockDecItems)         $+$
+       text "begin" $+$
+              nest nestVal (ppr concSms) $+$
+       text "end generate" <+> labelDoc <> semi
+  where labelDoc = ppr label
+  
+instance Ppr GenSm where
+  ppr (ForGn id dr) = text "for" <+> ppr id <+> text "in" <+> ppr dr
+  ppr (IfGn cond) = text "if" <+> ppr cond
+
+instance Ppr PMapAspect where
+ ppr (PMapAspect []) = empty
+ ppr (PMapAspect assocs) = text "port map" $$ 
+  (nest identL $ parens (ppr_list vComma assocs))
+  where identL = length "port map "
+         
+
+instance Ppr AssocElem where
+ ppr (formalPart :=>: actualPart) = formalPartDoc <+> ppr actualPart
+  where formalPartDoc = maybe empty (\fp -> ppr fp <+> text "=>") formalPart
+
+instance Ppr ActualDesig where
+ ppr (ADName name) = ppr name
+ ppr (ADExpr expr) = ppr expr
+ ppr Open          = text "open"
+
+instance Ppr ConSigAssignSm where
+ ppr (target :<==: cWforms) = ppr target <+> text "<=" <+> (ppr cWforms <> semi)
+
+
+instance Ppr ConWforms where
+ ppr (ConWforms whenElses wform lastElse) = ppr_list ($+$) whenElses $+$
+                                            ppr wform <+> ppr lastElse
+
+instance Ppr WhenElse where
+ ppr (WhenElse wform expr) = ppr wform <+> text "when" <+> 
+                             ppr expr  <+> text "else"
+
+instance Ppr When where
+ ppr (When cond) = text "when" <+> ppr cond
+
+instance Ppr Wform where
+ ppr (Wform elems) = ppr_list vComma elems
+ ppr Unaffected    = text "unaffected"
+
+instance Ppr WformElem where
+ ppr (WformElem exp mAfter) = ppr exp <+> (text "after" <++> ppr mAfter)
+
+
+instance Ppr CompInsSm where
+ ppr (CompInsSm label insUnit assocElems) =
+   ppr label <+> colon <+> (ppr insUnit $+$
+                            nest nestVal (ppr assocElems) <> semi)
+
+instance Ppr ProcSm where
+ ppr (ProcSm label sensl seqSms) =
+   ppr label <+> colon <+> text "process" <+> 
+   parensNonEmpty (ppr_list hComma sensl) $+$
+   text "begin" $+$
+        nest nestVal (ppr seqSms) $+$
+   text "end process" <+> labelDoc <> semi
+  where labelDoc = ppr label
+
+instance Ppr InsUnit where
+ ppr (IUEntity name) = text "entity" <+> ppr name
+
+-- FIXME, remove parenthesis according to precedence
+instance Ppr Expr where
+ ppr = pprExprPrec 0 ""
+
+
+-- | Prettyprint an binary infix operator 
+pprExprPrecInfix :: Int -- ^ Accumulated precedence value (initialized to 0)
+                 -> String -- ^ Enclosing operator (initialized to \"\")
+                 -> Int -- ^ Precedence of current infix operator   
+                 -> Expr -- ^ lhs expression
+                 -> String -- ^ operator name
+                 -> Expr -- ^ rhs expression
+                 -> Doc
+-- To avoid priting parenthesis based on the left
+-- associativity of all operators within the same precedence class, 
+-- the precedence passed to the left branch is curr instead of
+-- curr+1.
+--
+-- However, the VHDL grammar sometimes doesn't allow it 
+-- e.g. "and a or b and d" is illegal. In fact,
+-- you can only put two operators together without parenthesis
+-- in some cases:
+-- 
+-- * logical operators: "and", "or", "xor", "xnor", but cannot be mixed up.
+-- * relational operators: none
+-- * shift operators: none
+-- * adding operators: all, can be mixed up
+-- * multiplying operator: all, can be mixed up
+-- * misc operator: none
+--
+-- Thus, we keep track of the enclosing
+-- operator, and skip parenthesis according to left parsing associativity
+-- in the cases stated above.
+--
+-- Note that we are only making use of syntactic associativity. e.g.
+-- even if "+" is semantially associative: a+(b+c)=(a+b)+c,
+-- we will only skip parenthesis in (a+b)+c
+
+pprExprPrecInfix ac encop curr lhs op rhs = 
+ parensIf (ac>curr || (ac == curr && not skipParenSameLevel)) $
+   sep [pprExprPrec curr op lhs <+> text op, pprExprPrec (curr+1) op rhs]
+  where skipParenSameLevel = curr == plusPrec || curr == multPrec ||
+            (encop == op && op `elem` ["and","or","xor","xnor"])
+
+-- | Prettyprint unary prefix operators
+pprExprPrecPrefix :: Int -- ^ Accumulated precedence value (initialized to 0)
+                  -> Int -- ^ Precedence of current infix operator
+                  -> String -- ^ operator name
+                  -> Expr -- ^ operator argument
+                  -> Doc
+pprExprPrecPrefix ac curr op arg = parensIf (ac>curr) $
+  text op <+> pprExprPrec (curr+1) op arg
+
+
+-- | Prints an expression taking precedence and left associativity
+--   in account
+pprExprPrec :: Int  -- ^ Accumulated precedence value (initialized to 0)
+            -> String -- ^ Enclosing operator
+            -> Expr -- ^ Expression curently prettyprinted 
+            -> Doc
+-- Logical operations
+pprExprPrec p e (And e1 e2)  = pprExprPrecInfix p e logicalPrec e1 "and"  e2
+pprExprPrec p e (Or  e1 e2)  = pprExprPrecInfix p e logicalPrec e1 "or"   e2
+pprExprPrec p e (Xor e1 e2)  = pprExprPrecInfix p e logicalPrec e1 "xor"  e2
+pprExprPrec p e (Nand e1 e2) = pprExprPrecInfix p e logicalPrec e1 "nand" e2
+pprExprPrec p e (Nor  e1 e2) = pprExprPrecInfix p e logicalPrec e1 "nor"  e2
+pprExprPrec p e (Xnor e1 e2) = pprExprPrecInfix p e logicalPrec e1 "xnor" e2
+-- Relational Operators
+pprExprPrec p e (e1 :=:  e2) = pprExprPrecInfix p e relationalPrec e1 "="  e2
+pprExprPrec p e (e1 :/=: e2) = pprExprPrecInfix p e relationalPrec e1 "/=" e2
+pprExprPrec p e (e1 :<:  e2) = pprExprPrecInfix p e relationalPrec e1 "<"  e2
+pprExprPrec p e (e1 :<=: e2) = pprExprPrecInfix p e relationalPrec e1 "<=" e2
+pprExprPrec p e (e1 :>:  e2) = pprExprPrecInfix p e relationalPrec e1 ">"  e2
+pprExprPrec p e (e1 :>=: e2) = pprExprPrecInfix p e relationalPrec e1 ">=" e2
+-- Shift Operators
+pprExprPrec p e (Sll e1 e2) = pprExprPrecInfix p e shiftPrec e1 "sll" e2
+pprExprPrec p e (Srl e1 e2) = pprExprPrecInfix p e shiftPrec e1 "srl" e2
+pprExprPrec p e (Sla e1 e2) = pprExprPrecInfix p e shiftPrec e1 "sla" e2
+pprExprPrec p e (Sra e1 e2) = pprExprPrecInfix p e shiftPrec e1 "sra" e2
+pprExprPrec p e (Rol e1 e2) = pprExprPrecInfix p e shiftPrec e1 "rol" e2
+pprExprPrec p e (Ror e1 e2) = pprExprPrecInfix p e shiftPrec e1 "ror" e2
+-- Adding Operators
+pprExprPrec p e (e1 :+: e2) = pprExprPrecInfix p e plusPrec e1 "+" e2
+pprExprPrec p e (e1 :-: e2) = pprExprPrecInfix p e plusPrec e1 "-" e2
+pprExprPrec p e (e1 :&: e2) = pprExprPrecInfix p e plusPrec e1 "&" e2
+-- Sign Operators
+pprExprPrec p _ (Neg e) = pprExprPrecPrefix p signPrec "-" e 
+pprExprPrec p _ (Pos e) = pprExprPrecPrefix p signPrec "+" e 
+-- Multiplying Operators
+pprExprPrec p e (e1 :*: e2) = pprExprPrecInfix p e multPrec e1 "*" e2
+pprExprPrec p e (e1 :/: e2) = pprExprPrecInfix p e multPrec e1 "/" e2
+pprExprPrec p e (Mod e1 e2) = pprExprPrecInfix p e multPrec e1 "mod" e2
+pprExprPrec p e (Rem e1 e2) = pprExprPrecInfix p e multPrec e1 "rem" e2
+-- Miscellaneous Operators
+pprExprPrec p e (e1 :**: e2) = pprExprPrecInfix p e miscPrec e1 "**" e2
+pprExprPrec p _ (Abs e) = pprExprPrecPrefix p signPrec "abs" e 
+pprExprPrec p _ (Not e) = pprExprPrecPrefix p signPrec "not" e 
+-- Primary expressions
+pprExprPrec _ _ (PrimName name)    = ppr name
+pprExprPrec _ _ (PrimLit  lit)     = text lit
+pprExprPrec _ _ (PrimFCall fCall)  = ppr fCall
+-- Composite-type  expressions
+pprExprPrec _ _ (Aggregate assocs) = parens (ppr_list hComma  assocs)
+
+instance Ppr ElemAssoc where
+ ppr (ElemAssoc mChoice expr) = (ppr mChoice <++> text "=>") <+> ppr expr
+
+instance Ppr FCall where
+ ppr (FCall name assocs) = 
+   ppr name <> parensNonEmpty (commaSep assocs)
+
diff --git a/Language/VHDL/Error.hs b/Language/VHDL/Error.hs
new file mode 100644
--- /dev/null
+++ b/Language/VHDL/Error.hs
@@ -0,0 +1,64 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.VHDL.Error
+-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  christiaan.baaij@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- ForSyDe error-related types and functions.
+--
+-----------------------------------------------------------------------------
+module Language.VHDL.Error 
+ (VHDLErr(..),
+  EProne,
+  module Control.Monad.Error,
+  module Debug.Trace) where
+
+import Debug.Trace
+import Control.Monad.Error 
+
+-------------
+-- VHDLErr
+-------------
+
+-- | All Errors thrown or displayed in ForSyDe
+data VHDLErr = 
+  -- Used in ForSyDe.Backend.VHDL.*
+  -- | Empty VHDL identifier
+  EmptyVHDLId                                |
+  -- | Incorrect Basic VHDL Identifier
+  IncVHDLBasId String                        |
+  -- | Incorrect Extended VHDL Identifier
+  IncVHDLExtId String                        |
+  -- | Other Errors
+  Other String
+
+-- | Show errors
+instance Show VHDLErr where
+ show EmptyVHDLId = "Empty VHDL identifier"
+ show (IncVHDLBasId id)  = "Incorrect VHDL basic identifier " ++ 
+                           "`" ++ id ++ "'"
+ show (IncVHDLExtId id)  = "Incorrect VHDL extended identifier " ++ 
+                           "`" ++ id ++ "'"
+
+--------------
+-- Error Monad
+--------------
+
+-- | We make CLasHErr an instance of the Error class to be able to throw it
+-- as an exception.
+instance Error VHDLErr where
+ noMsg  = Other "An Error has ocurred"
+ strMsg = Other
+
+-- | 'EProne' represents failure using Left CLasHErr  or a successful 
+--   result of type a using Right a
+-- 
+--  'EProne' is implicitly an instance of 
+--   ['MonadError']  (@Error e => MonadError e (Either e)@)
+--   ['Monad']       (@Error e => Monad (Either e)@)
+type EProne = Either VHDLErr
+-- FIXME: Rethink Eprone so that it takes contexts in account
diff --git a/Language/VHDL/FileIO.hs b/Language/VHDL/FileIO.hs
new file mode 100644
--- /dev/null
+++ b/Language/VHDL/FileIO.hs
@@ -0,0 +1,30 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.VHDL.FileIO
+-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  forsyde-dev@ict.kth.se
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Functions working with files in the VHDL backend. 
+--
+-----------------------------------------------------------------------------
+module Language.VHDL.FileIO (writeDesignFile) where
+
+import Language.VHDL.AST
+import Language.VHDL.AST.Ppr() -- instances
+import qualified Language.VHDL.Ppr as Ppr (ppr)
+
+import System.IO
+import Text.PrettyPrint.HughesPJ
+
+-- | Write a design file to a file in disk
+writeDesignFile :: DesignFile -> FilePath -> IO ()
+writeDesignFile df fp = do
+  handle     <- openFile fp WriteMode
+  hPutStrLn handle "-- Automatically generated VHDL"
+  hPutStr handle $ (renderStyle mystyle . Ppr.ppr) df
+  hClose handle
+ where mystyle = style{lineLength=80, ribbonsPerLine=1}
diff --git a/Language/VHDL/Ppr.hs b/Language/VHDL/Ppr.hs
new file mode 100644
--- /dev/null
+++ b/Language/VHDL/Ppr.hs
@@ -0,0 +1,106 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.VHDL.Ppr
+-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  christiaan.baaij@gmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable (Template Haskell)
+--
+-- ForSyDe pretty-printing class and auxiliar functions.
+--
+-----------------------------------------------------------------------------
+module Language.VHDL.Ppr where
+
+import Text.PrettyPrint.HughesPJ
+
+-- | Pretty printing class
+class Ppr a where
+ ppr :: a -> Doc
+
+-- identity instantiation
+instance Ppr Doc where
+ ppr = id
+
+-- | Pretty printing class with associated printing options
+class PprOps ops toPpr | toPpr -> ops where
+ -- NOTE: Would it be better to use a State Monad?
+ -- i.e. pprOps :: toPpr -> State ops Doc
+ pprOps :: ops -> toPpr -> Doc 
+
+
+-- dot
+dot :: Doc
+dot = char '.'
+
+-- One line vertical space
+vSpace :: Doc
+vSpace = text ""
+
+-- Multi-line vertical space
+multiVSpace :: Int -> Doc
+multiVSpace  n = vcat (replicate n (text ""))  
+
+-- Pretty-print a list supplying the document joining function
+ppr_list :: Ppr a => (Doc -> Doc -> Doc) -> [a] -> Doc
+ppr_list _ []    = empty
+ppr_list join (a1:rest) = go a1 rest 
+  where go a1 []        = ppr a1
+        go a1 (a2:rest) = ppr a1 `join` go a2 rest
+
+-- Pretty-print a list supplying the document joining function
+-- (PprOps version)
+pprOps_list :: PprOps ops toPpr => ops -> (Doc -> Doc -> Doc) -> [toPpr] -> Doc
+pprOps_list _ _ [] = empty
+pprOps_list ops join (a1:rest) = go a1 rest
+ where go a1 [] = pprOps ops a1
+       go a1 (a2:rest) = pprOps ops a1 `join` go a2 rest
+
+-- | Join two documents vertically leaving n vertical spaces between them
+vNSpaces :: Int -> Doc -> Doc -> Doc
+vNSpaces n doc1 doc2 = doc1 $+$ 
+                        multiVSpace n $+$
+                       doc2
+
+-- Join two documents vertically putting a semicolon in the middle
+vSemi :: Doc -> Doc -> Doc
+vSemi doc1 doc2 = doc1 <> semi $+$ doc2
+
+
+-- Join two documents vertically putting a comma in the middle
+vComma :: Doc -> Doc -> Doc
+vComma doc1 doc2 = doc1 <> comma $+$ doc2
+
+-- Join two documents horizontally putting a comma in the middle
+hComma :: Doc -> Doc -> Doc
+hComma doc1 doc2 = doc1 <> comma <+> doc2
+
+
+-- | apply sep to a list of prettyprintable elements, 
+--   previously interspersing commas
+commaSep :: Ppr a => [a] -> Doc
+commaSep = sep.(punctuate comma).(map ppr)
+ 
+
+-- | Only append if both of the documents are non-empty
+($++$) :: Doc -> Doc -> Doc
+d1 $++$ d2 
+ | isEmpty d1 || isEmpty d2 = empty
+ | otherwise = d1 $+$ d2
+
+
+-- | Only append if both of the documents are non-empty
+(<++>) :: Doc -> Doc -> Doc
+d1 <++> d2 
+ | isEmpty d1 || isEmpty d2 = empty
+ | otherwise = d1 <+> d2
+
+-- | Enclose in parenthesis only if the document is non-empty
+parensNonEmpty :: Doc -> Doc
+parensNonEmpty doc | isEmpty doc = empty
+parensNonEmpty doc = parens doc
+
+-- | Enclose in parenthesis only if the predicate is True
+parensIf :: Bool -> Doc -> Doc
+parensIf p d = if p then parens d else d
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/vhdl.cabal b/vhdl.cabal
new file mode 100644
--- /dev/null
+++ b/vhdl.cabal
@@ -0,0 +1,23 @@
+name:                vhdl
+version:             0.1.1
+synopsis:            VHDL AST and pretty printer
+description:         VHDL AST and pretty printer, should only be used for building AST's, not as part of a VHDL parser
+category:            Language
+license:             BSD3
+license-file:        LICENSE
+copyright:           Copyright (c) 2009 Christiaan Baaij & Matthijs Kooijman
+author:              Christiaan Baaij
+maintainer:          christiaan.baaij@gmail.com
+package-url:         http://github.com/christiaanb/vhdl/tree/master
+build-type:          Simple
+cabal-version:       >=1.2  
+
+Library
+  extensions:        FlexibleInstances, MultiParamTypeClasses, 
+                     FunctionalDependencies
+  build-depends:     base >= 4.0 && < 5, regex-posix, pretty, mtl
+  exposed-modules:   Language.VHDL.AST,
+                     Language.VHDL.AST.Ppr
+                     Language.VHDL.Ppr,
+                     Language.VHDL.FileIO
+  other-modules:     Language.VHDL.Error