diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,7 +1,17 @@
 Change log for curry-frontend
 =============================
 
-Under development (1.0.1)
+Version 1.0.2
+=============
+
+  * Added 'short-ast' and 'ast' as new compilation targets
+  * Fixed bug with wrong type of free variables in the intermediate language.
+  * Fixed bug with generated default implementations of nullary class methods.
+  * Fixed bug in desugaring of record patterns.
+  * Fixed bug that external data declarations weren't considered when
+    AbstractCurry was generated
+
+Version 1.0.1
 =============
 
   * Fixed bug with wrong order of super classes in selector functions
diff --git a/curry-frontend.cabal b/curry-frontend.cabal
--- a/curry-frontend.cabal
+++ b/curry-frontend.cabal
@@ -1,5 +1,5 @@
 Name:          curry-frontend
-Version:       1.0.1
+Version:       1.0.2
 Cabal-Version: >= 1.10
 Synopsis:      Compile the functional logic language Curry to several
                intermediate formats
@@ -43,7 +43,7 @@
   Build-Depends:
       base == 4.*
     , containers
-    , curry-base == 1.0.0
+    , curry-base == 1.1.0
     , directory
     , extra >= 1.4.6
     , filepath
@@ -108,6 +108,7 @@
     , Generators.GenAbstractCurry
     , Generators.GenFlatCurry
     , Generators.GenTypedFlatCurry
+    , Generators.GenTypeAnnotatedFlatCurry
     , Html.CurryHtml
     , Html.SyntaxColoring
     , IL
@@ -140,7 +141,7 @@
   Build-Depends:
       base == 4.*
     , containers
-    , curry-base == 1.0.0
+    , curry-base == 1.1.0
     , curry-frontend
     , directory
     , extra >= 1.4.6
@@ -161,5 +162,5 @@
   hs-source-dirs: test
   default-language:  Haskell2010
   test-module:    TestFrontend
-  build-depends:  base == 4.*, Cabal >= 1.20, curry-base == 1.0.0
+  build-depends:  base == 4.*, Cabal >= 1.20, curry-base == 1.1.0
     , curry-frontend, filepath
diff --git a/src/Base/AnnotExpr.hs b/src/Base/AnnotExpr.hs
--- a/src/Base/AnnotExpr.hs
+++ b/src/Base/AnnotExpr.hs
@@ -15,6 +15,7 @@
 import qualified Data.Set  as Set (fromList, notMember)
 
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.Expr
@@ -46,39 +47,39 @@
 
 instance QualAnnotExpr Rhs where
   qafv m (SimpleRhs _ e ds) = filterBv ds $ qafv m e ++ concatMap (qafv m) ds
-  qafv m (GuardedRhs es ds) =
+  qafv m (GuardedRhs _ es ds) =
     filterBv ds $ concatMap (qafv m) es ++ concatMap (qafv m) ds
 
 instance QualAnnotExpr CondExpr where
   qafv m (CondExpr _ g e) = qafv m g ++ qafv m e
 
 instance QualAnnotExpr Expression where
-  qafv _ (Literal             _ _) = []
-  qafv m (Variable           ty v) =
+  qafv _ (Literal             _ _ _) = []
+  qafv m (Variable           _ ty v) =
     maybe [] (return . (\v' -> (ty, v'))) $ localIdent m v
-  qafv _ (Constructor         _ _) = []
-  qafv m (Paren                 e) = qafv m e
-  qafv m (Typed               e _) = qafv m e
-  qafv m (Record           _ _ fs) = concatMap (qafvField m) fs
-  qafv m (RecordUpdate       e fs) = qafv m e ++ concatMap (qafvField m) fs
-  qafv m (Tuple                es) = concatMap (qafv m) es
-  qafv m (List               _ es) = concatMap (qafv m) es
-  qafv m (ListCompr          e qs) = foldr (qafvStmt m) (qafv m e) qs
-  qafv m (EnumFrom              e) = qafv m e
-  qafv m (EnumFromThen      e1 e2) = qafv m e1 ++ qafv m e2
-  qafv m (EnumFromTo        e1 e2) = qafv m e1 ++ qafv m e2
-  qafv m (EnumFromThenTo e1 e2 e3) = qafv m e1 ++ qafv m e2 ++ qafv m e3
-  qafv m (UnaryMinus            e) = qafv m e
-  qafv m (Apply             e1 e2) = qafv m e1 ++ qafv m e2
-  qafv m (InfixApply     e1 op e2) = qafv m op ++ qafv m e1 ++ qafv m e2
-  qafv m (LeftSection        e op) = qafv m op ++ qafv m e
-  qafv m (RightSection       op e) = qafv m op ++ qafv m e
-  qafv m (Lambda             ts e) = filterBv ts $ qafv m e
-  qafv m (Let                ds e) =
+  qafv _ (Constructor         _ _ _) = []
+  qafv m (Paren                 _ e) = qafv m e
+  qafv m (Typed               _ e _) = qafv m e
+  qafv m (Record           _ _ _ fs) = concatMap (qafvField m) fs
+  qafv m (RecordUpdate       _ e fs) = qafv m e ++ concatMap (qafvField m) fs
+  qafv m (Tuple                _ es) = concatMap (qafv m) es
+  qafv m (List               _ _ es) = concatMap (qafv m) es
+  qafv m (ListCompr          _ e qs) = foldr (qafvStmt m) (qafv m e) qs
+  qafv m (EnumFrom              _ e) = qafv m e
+  qafv m (EnumFromThen      _ e1 e2) = qafv m e1 ++ qafv m e2
+  qafv m (EnumFromTo        _ e1 e2) = qafv m e1 ++ qafv m e2
+  qafv m (EnumFromThenTo _ e1 e2 e3) = qafv m e1 ++ qafv m e2 ++ qafv m e3
+  qafv m (UnaryMinus            _ e) = qafv m e
+  qafv m (Apply             _ e1 e2) = qafv m e1 ++ qafv m e2
+  qafv m (InfixApply     _ e1 op e2) = qafv m op ++ qafv m e1 ++ qafv m e2
+  qafv m (LeftSection        _ e op) = qafv m op ++ qafv m e
+  qafv m (RightSection       _ op e) = qafv m op ++ qafv m e
+  qafv m (Lambda             _ ts e) = filterBv ts $ qafv m e
+  qafv m (Let                _ ds e) =
     filterBv ds $ concatMap (qafv m) ds ++ qafv m e
-  qafv m (Do                sts e) = foldr (qafvStmt m) (qafv m e) sts
-  qafv m (IfThenElse     e1 e2 e3) = qafv m e1 ++ qafv m e2 ++ qafv m e3
-  qafv m (Case           _ e alts) = qafv m e ++ concatMap (qafv m) alts
+  qafv m (Do                _ sts e) = foldr (qafvStmt m) (qafv m e) sts
+  qafv m (IfThenElse     _ e1 e2 e3) = qafv m e1 ++ qafv m e2 ++ qafv m e3
+  qafv m (Case           _ _ e alts) = qafv m e ++ concatMap (qafv m) alts
 
 qafvField :: QualAnnotExpr e => ModuleIdent -> Field (e Type) -> [(Type, Ident)]
 qafvField m (Field _ _ t) = qafv m t
@@ -87,34 +88,34 @@
 qafvStmt m st fvs = qafv m st ++ filterBv st fvs
 
 instance QualAnnotExpr Statement where
-  qafv m (StmtExpr   e) = qafv m e
-  qafv m (StmtDecl  ds) = filterBv ds $ concatMap (qafv m) ds
-  qafv m (StmtBind _ e) = qafv m e
+  qafv m (StmtExpr   _ e) = qafv m e
+  qafv m (StmtDecl  _ ds) = filterBv ds $ concatMap (qafv m) ds
+  qafv m (StmtBind _ _ e) = qafv m e
 
 instance QualAnnotExpr Alt where
   qafv m (Alt _ t rhs) = filterBv t $ qafv m rhs
 
 instance QualAnnotExpr InfixOp where
-  qafv m (InfixOp    ty op) = qafv m $ Variable ty op
+  qafv m (InfixOp    ty op) = qafv m $ Variable NoSpanInfo ty op
   qafv _ (InfixConstr _ _ ) = []
 
 instance QualAnnotExpr Pattern where
-  qafv _ (LiteralPattern           _ _) = []
-  qafv _ (NegativePattern          _ _) = []
-  qafv _ (VariablePattern          _ _) = []
-  qafv m (ConstructorPattern    _ _ ts) = concatMap (qafv m) ts
-  qafv m (InfixPattern       _ t1 _ t2) = qafv m t1 ++ qafv m t2
-  qafv m (ParenPattern               t) = qafv m t
-  qafv m (RecordPattern         _ _ fs) = concatMap (qafvField m) fs
-  qafv m (TuplePattern              ts) = concatMap (qafv m) ts
-  qafv m (ListPattern             _ ts) = concatMap (qafv m) ts
-  qafv m (AsPattern                _ t) = qafv m t
-  qafv m (LazyPattern                t) = qafv m t
-  qafv m (FunctionPattern      ty f ts) =
+  qafv _ (LiteralPattern           _ _ _) = []
+  qafv _ (NegativePattern          _ _ _) = []
+  qafv _ (VariablePattern          _ _ _) = []
+  qafv m (ConstructorPattern    _ _ _ ts) = concatMap (qafv m) ts
+  qafv m (InfixPattern       _ _ t1 _ t2) = qafv m t1 ++ qafv m t2
+  qafv m (ParenPattern               _ t) = qafv m t
+  qafv m (RecordPattern         _ _ _ fs) = concatMap (qafvField m) fs
+  qafv m (TuplePattern              _ ts) = concatMap (qafv m) ts
+  qafv m (ListPattern             _ _ ts) = concatMap (qafv m) ts
+  qafv m (AsPattern                _ _ t) = qafv m t
+  qafv m (LazyPattern                _ t) = qafv m t
+  qafv m (FunctionPattern      _ ty f ts) =
     maybe [] (return . (\f' -> (ty', f'))) (localIdent m f) ++
       concatMap (qafv m) ts
     where ty' = foldr TypeArrow ty $ map typeOf ts
-  qafv m (InfixFuncPattern ty t1 op t2) =
+  qafv m (InfixFuncPattern _ ty t1 op t2) =
     maybe [] (return . (\op' -> (ty', op'))) (localIdent m op) ++
       concatMap (qafv m) [t1, t2]
     where ty' = foldr TypeArrow ty $ map typeOf [t1, t2]
diff --git a/src/Base/CurryTypes.hs b/src/Base/CurryTypes.hs
--- a/src/Base/CurryTypes.hs
+++ b/src/Base/CurryTypes.hs
@@ -39,6 +39,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Pretty (Doc)
+import Curry.Base.SpanInfo
 import qualified Curry.Syntax as CS
 import Curry.Syntax.Pretty (ppConstraint, ppTypeExpr, ppQualTypeExpr)
 
@@ -59,25 +60,26 @@
 toTypes tvs tys = map ((flip (toType' (enumTypeVars tvs tys))) []) tys
 
 toType' :: Map.Map Ident Int -> CS.TypeExpr -> [Type] -> Type
-toType' _   (CS.ConstructorType tc) tys = applyType (TypeConstructor tc) tys
-toType' tvs (CS.ApplyType  ty1 ty2) tys =
+toType' _   (CS.ConstructorType _ tc) tys = applyType (TypeConstructor tc) tys
+toType' tvs (CS.ApplyType  _ ty1 ty2) tys =
   toType' tvs ty1 (toType' tvs ty2 [] : tys)
-toType' tvs (CS.VariableType    tv) tys =
+toType' tvs (CS.VariableType    _ tv) tys =
   applyType (TypeVariable (toVar tvs tv)) tys
-toType' tvs (CS.TupleType      tys) tys'
+toType' tvs (CS.TupleType      _ tys) tys'
   | null tys  = internalError "Base.CurryTypes.toType': zero-element tuple"
   | null tys' = tupleType $ map ((flip $ toType' tvs) []) tys
   | otherwise = internalError "Base.CurryTypes.toType': tuple type application"
-toType' tvs (CS.ListType        ty) tys
+toType' tvs (CS.ListType        _ ty) tys
   | null tys  = listType $ toType' tvs ty []
   | otherwise = internalError "Base.CurryTypes.toType': list type application"
-toType' tvs (CS.ArrowType  ty1 ty2) tys
+toType' tvs (CS.ArrowType  _ ty1 ty2) tys
   | null tys = TypeArrow (toType' tvs ty1 []) (toType' tvs ty2 [])
   | otherwise = internalError "Base.CurryTypes.toType': arrow type application"
-toType' tvs (CS.ParenType       ty) tys = toType' tvs ty tys
-toType' tvs (CS.ForallType tvs' ty) tys
+toType' tvs (CS.ParenType       _ ty) tys = toType' tvs ty tys
+toType' tvs (CS.ForallType _ tvs' ty) tys
   | null tvs' = toType' tvs ty tys
-  | otherwise = applyType (TypeForall (map (toVar tvs) tvs') (toType' tvs ty []))
+  | otherwise = applyType (TypeForall (map (toVar tvs) tvs')
+                                      (toType' tvs ty []))
                           tys
 
 toVar :: Map.Map Ident Int -> Ident -> Int
@@ -95,7 +97,7 @@
 toPred tvs c = toPred' (enumTypeVars tvs c) c
 
 toPred' :: Map.Map Ident Int -> CS.Constraint -> Pred
-toPred' tvs (CS.Constraint qcls ty) = Pred qcls (toType' tvs ty [])
+toPred' tvs (CS.Constraint _ qcls ty) = Pred qcls (toType' tvs ty [])
 
 toQualPred :: ModuleIdent -> [Ident] -> CS.Constraint -> Pred
 toQualPred m tvs = qualifyPred m . toPred tvs
@@ -113,7 +115,7 @@
 toPredType tvs qty = toPredType' (enumTypeVars tvs qty) qty
 
 toPredType' :: Map.Map Ident Int -> CS.QualTypeExpr -> PredType
-toPredType' tvs (CS.QualTypeExpr cx ty) =
+toPredType' tvs (CS.QualTypeExpr _ cx ty) =
   PredType (toPredSet' tvs cx) (toType' tvs ty [])
 
 toQualPredType :: ModuleIdent -> [Ident] -> CS.QualTypeExpr -> PredType
@@ -124,19 +126,21 @@
 -- which are free in the argument types.
 
 toConstrType :: QualIdent -> [Ident] -> CS.Context -> [CS.TypeExpr] -> PredType
-toConstrType tc tvs cx tys = toPredType tvs $ CS.QualTypeExpr cx' ty'
+toConstrType tc tvs cx tys = toPredType tvs $
+  CS.QualTypeExpr NoSpanInfo cx' ty' 
   where tvs' = nub (fv tys)
         cx'  = restrictContext tvs' cx
-        ty'  = foldr CS.ArrowType ty0 tys
-        ty0  = foldl CS.ApplyType
-                     (CS.ConstructorType tc)
-                     (map CS.VariableType tvs)
+        ty'  = foldr (CS.ArrowType NoSpanInfo) ty0 tys
+        ty0  = foldl (CS.ApplyType NoSpanInfo)
+                     (CS.ConstructorType NoSpanInfo tc)
+                     (map (CS.VariableType NoSpanInfo) tvs)
 
 restrictContext :: [Ident] -> CS.Context -> CS.Context
 restrictContext tvs cx =
-  [CS.Constraint cls ty | CS.Constraint cls ty <- cx, classVar ty `elem` tvs]
-  where classVar (CS.VariableType tv) = tv
-        classVar (CS.ApplyType  ty _) = classVar ty
+  [CS.Constraint spi cls ty
+    | CS.Constraint spi cls ty <- cx, classVar ty `elem` tvs]
+  where classVar (CS.VariableType _ tv) = tv
+        classVar (CS.ApplyType  _ ty _) = classVar ty
         classVar _ = internalError "Base.CurryTypes.restrictContext.classVar"
 
 -- The function 'toMethodType' returns the type of a type class method.
@@ -144,32 +148,39 @@
 -- and ensures that the class' type variable is always assigned index 0.
 
 toMethodType :: QualIdent -> Ident -> CS.QualTypeExpr -> PredType
-toMethodType qcls clsvar (CS.QualTypeExpr cx ty) =
-  toPredType [clsvar] (CS.QualTypeExpr cx' ty)
-  where cx' = CS.Constraint qcls (CS.VariableType clsvar) : cx
+toMethodType qcls clsvar (CS.QualTypeExpr spi cx ty) =
+  toPredType [clsvar] (CS.QualTypeExpr spi cx' ty)
+  where cx' = CS.Constraint NoSpanInfo qcls
+                (CS.VariableType NoSpanInfo clsvar) : cx
 
 fromType :: [Ident] -> Type -> CS.TypeExpr
 fromType tvs ty = fromType' tvs ty []
 
 fromType' :: [Ident] -> Type -> [CS.TypeExpr] -> CS.TypeExpr
 fromType' _   (TypeConstructor    tc) tys
-  | isQTupleId tc && qTupleArity tc == length tys = CS.TupleType tys
-  | tc == qListId && length tys == 1              = CS.ListType (head tys)
+  | isQTupleId tc && qTupleArity tc == length tys
+    = CS.TupleType NoSpanInfo tys
+  | tc == qListId && length tys == 1
+    = CS.ListType NoSpanInfo (head tys)
   | otherwise
-  = foldl CS.ApplyType (CS.ConstructorType tc) tys
+  = foldl (CS.ApplyType NoSpanInfo) (CS.ConstructorType NoSpanInfo tc) tys
 fromType' tvs (TypeApply     ty1 ty2) tys =
   fromType' tvs ty1 (fromType tvs ty2 : tys)
 fromType' tvs (TypeVariable       tv) tys =
-  foldl CS.ApplyType (CS.VariableType (fromVar tvs tv)) tys
+  foldl (CS.ApplyType NoSpanInfo) (CS.VariableType NoSpanInfo (fromVar tvs tv))
+    tys
 fromType' tvs (TypeArrow     ty1 ty2) tys =
-  foldl CS.ApplyType (CS.ArrowType (fromType tvs ty1) (fromType tvs ty2)) tys
+  foldl (CS.ApplyType NoSpanInfo)
+    (CS.ArrowType NoSpanInfo (fromType tvs ty1) (fromType tvs ty2)) tys
 fromType' tvs (TypeConstrained tys _) tys' = fromType' tvs (head tys) tys'
 fromType' _   (TypeSkolem          k) tys =
-  foldl CS.ApplyType (CS.VariableType $ mkIdent $ "_?" ++ show k) tys
+  foldl (CS.ApplyType NoSpanInfo)
+    (CS.VariableType NoSpanInfo $ mkIdent $ "_?" ++ show k) tys
 fromType' tvs (TypeForall    tvs' ty) tys
   | null tvs' = fromType' tvs ty tys
-  | otherwise = foldl CS.ApplyType
-                      (CS.ForallType (map (fromVar tvs) tvs') (fromType tvs ty))
+  | otherwise = foldl (CS.ApplyType NoSpanInfo)
+                      (CS.ForallType NoSpanInfo (map (fromVar tvs) tvs')
+                                                (fromType tvs ty))
                       tys
 
 fromVar :: [Ident] -> Int -> Ident
@@ -179,7 +190,7 @@
 fromQualType m tvs = fromType tvs . unqualifyType m
 
 fromPred :: [Ident] -> Pred -> CS.Constraint
-fromPred tvs (Pred qcls ty) = CS.Constraint qcls (fromType tvs ty)
+fromPred tvs (Pred qcls ty) = CS.Constraint NoSpanInfo qcls (fromType tvs ty)
 
 fromQualPred :: ModuleIdent -> [Ident] -> Pred -> CS.Constraint
 fromQualPred m tvs = fromPred tvs .  unqualifyPred m
@@ -195,7 +206,7 @@
 
 fromPredType :: [Ident] -> PredType -> CS.QualTypeExpr
 fromPredType tvs (PredType ps ty) =
-  CS.QualTypeExpr (fromPredSet tvs ps) (fromType tvs ty)
+  CS.QualTypeExpr NoSpanInfo (fromPredSet tvs ps) (fromType tvs ty)
 
 fromQualPredType :: ModuleIdent -> [Ident] -> PredType -> CS.QualTypeExpr
 fromQualPredType m tvs = fromPredType tvs . unqualifyPredType m
diff --git a/src/Base/Expr.hs b/src/Base/Expr.hs
--- a/src/Base/Expr.hs
+++ b/src/Base/Expr.hs
@@ -27,6 +27,7 @@
 import qualified Data.Set  as Set (fromList, notMember)
 
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 class Expr e where
@@ -83,44 +84,44 @@
 
 instance QualExpr (Rhs a) where
   qfv m (SimpleRhs _ e ds) = filterBv ds $ qfv m e  ++ qfv m ds
-  qfv m (GuardedRhs es ds) = filterBv ds $ qfv m es ++ qfv m ds
+  qfv m (GuardedRhs _ es ds) = filterBv ds $ qfv m es ++ qfv m ds
 
 instance QualExpr (CondExpr a) where
   qfv m (CondExpr _ g e) = qfv m g ++ qfv m e
 
 instance QualExpr (Expression a) where
-  qfv _ (Literal             _ _) = []
-  qfv m (Variable            _ v) = maybe [] return $ localIdent m v
-  qfv _ (Constructor         _ _) = []
-  qfv m (Paren                 e) = qfv m e
-  qfv m (Typed               e _) = qfv m e
-  qfv m (Record           _ _ fs) = qfv m fs
-  qfv m (RecordUpdate       e fs) = qfv m e ++ qfv m fs
-  qfv m (Tuple                es) = qfv m es
-  qfv m (List               _ es) = qfv m es
-  qfv m (ListCompr          e qs) = foldr (qfvStmt m) (qfv m e) qs
-  qfv m (EnumFrom              e) = qfv m e
-  qfv m (EnumFromThen      e1 e2) = qfv m e1 ++ qfv m e2
-  qfv m (EnumFromTo        e1 e2) = qfv m e1 ++ qfv m e2
-  qfv m (EnumFromThenTo e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
-  qfv m (UnaryMinus            e) = qfv m e
-  qfv m (Apply             e1 e2) = qfv m e1 ++ qfv m e2
-  qfv m (InfixApply     e1 op e2) = qfv m op ++ qfv m e1 ++ qfv m e2
-  qfv m (LeftSection        e op) = qfv m op ++ qfv m e
-  qfv m (RightSection       op e) = qfv m op ++ qfv m e
-  qfv m (Lambda             ts e) = filterBv ts $ qfv m e
-  qfv m (Let                ds e) = filterBv ds $ qfv m ds ++ qfv m e
-  qfv m (Do                sts e) = foldr (qfvStmt m) (qfv m e) sts
-  qfv m (IfThenElse     e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
-  qfv m (Case           _ e alts) = qfv m e ++ qfv m alts
+  qfv _ (Literal             _ _ _) = []
+  qfv m (Variable            _ _ v) = maybe [] return $ localIdent m v
+  qfv _ (Constructor         _ _ _) = []
+  qfv m (Paren               _   e) = qfv m e
+  qfv m (Typed               _ e _) = qfv m e
+  qfv m (Record           _ _ _ fs) = qfv m fs
+  qfv m (RecordUpdate       _ e fs) = qfv m e ++ qfv m fs
+  qfv m (Tuple                _ es) = qfv m es
+  qfv m (List               _ _ es) = qfv m es
+  qfv m (ListCompr          _ e qs) = foldr (qfvStmt m) (qfv m e) qs
+  qfv m (EnumFrom              _ e) = qfv m e
+  qfv m (EnumFromThen      _ e1 e2) = qfv m e1 ++ qfv m e2
+  qfv m (EnumFromTo        _ e1 e2) = qfv m e1 ++ qfv m e2
+  qfv m (EnumFromThenTo _ e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
+  qfv m (UnaryMinus            _ e) = qfv m e
+  qfv m (Apply             _ e1 e2) = qfv m e1 ++ qfv m e2
+  qfv m (InfixApply     _ e1 op e2) = qfv m op ++ qfv m e1 ++ qfv m e2
+  qfv m (LeftSection        _ e op) = qfv m op ++ qfv m e
+  qfv m (RightSection       _ op e) = qfv m op ++ qfv m e
+  qfv m (Lambda             _ ts e) = filterBv ts $ qfv m e
+  qfv m (Let                _ ds e) = filterBv ds $ qfv m ds ++ qfv m e
+  qfv m (Do                _ sts e) = foldr (qfvStmt m) (qfv m e) sts
+  qfv m (IfThenElse     _ e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
+  qfv m (Case           _ _ e alts) = qfv m e ++ qfv m alts
 
 qfvStmt :: ModuleIdent -> (Statement a) -> [Ident] -> [Ident]
 qfvStmt m st fvs = qfv m st ++ filterBv st fvs
 
 instance QualExpr (Statement a) where
-  qfv m (StmtExpr   e) = qfv m e
-  qfv m (StmtDecl  ds) = filterBv ds $ qfv m ds
-  qfv m (StmtBind _ e) = qfv m e
+  qfv m (StmtExpr   _ e) = qfv m e
+  qfv m (StmtDecl  _ ds) = filterBv ds $ qfv m ds
+  qfv m (StmtBind _ _ e) = qfv m e
 
 instance QualExpr (Alt a) where
   qfv m (Alt _ t rhs) = filterBv t $ qfv m rhs
@@ -135,77 +136,77 @@
   qfv m (Field _ _ t) = qfv m t
 
 instance QuantExpr (Statement a) where
-  bv (StmtExpr   _) = []
-  bv (StmtBind t _) = bv t
-  bv (StmtDecl  ds) = bv ds
+  bv (StmtExpr   _ _) = []
+  bv (StmtBind _ t _) = bv t
+  bv (StmtDecl  _ ds) = bv ds
 
 instance QualExpr (InfixOp a) where
-  qfv m (InfixOp     a op) = qfv m $ Variable a op
+  qfv m (InfixOp     a op) = qfv m $ Variable NoSpanInfo a op
   qfv _ (InfixConstr _ _ ) = []
 
 instance QuantExpr (Pattern a) where
-  bv (LiteralPattern         _ _) = []
-  bv (NegativePattern        _ _) = []
-  bv (VariablePattern        _ v) = [v]
-  bv (ConstructorPattern  _ _ ts) = bv ts
-  bv (InfixPattern     _ t1 _ t2) = bv t1 ++ bv t2
-  bv (ParenPattern             t) = bv t
-  bv (RecordPattern       _ _ fs) = bv fs
-  bv (TuplePattern            ts) = bv ts
-  bv (ListPattern           _ ts) = bv ts
-  bv (AsPattern              v t) = v : bv t
-  bv (LazyPattern              t) = bv t
-  bv (FunctionPattern     _ _ ts) = nub $ bv ts
-  bv (InfixFuncPattern _ t1 _ t2) = nub $ bv t1 ++ bv t2
+  bv (LiteralPattern         _ _ _) = []
+  bv (NegativePattern        _ _ _) = []
+  bv (VariablePattern        _ _ v) = [v]
+  bv (ConstructorPattern  _ _ _ ts) = bv ts
+  bv (InfixPattern     _ _ t1 _ t2) = bv t1 ++ bv t2
+  bv (ParenPattern             _ t) = bv t
+  bv (RecordPattern       _ _ _ fs) = bv fs
+  bv (TuplePattern           _  ts) = bv ts
+  bv (ListPattern          _  _ ts) = bv ts
+  bv (AsPattern              _ v t) = v : bv t
+  bv (LazyPattern              _ t) = bv t
+  bv (FunctionPattern     _ _ _ ts) = nub $ bv ts
+  bv (InfixFuncPattern _ _ t1 _ t2) = nub $ bv t1 ++ bv t2
 
 instance QualExpr (Pattern a) where
-  qfv _ (LiteralPattern          _ _) = []
-  qfv _ (NegativePattern         _ _) = []
-  qfv _ (VariablePattern         _ _) = []
-  qfv m (ConstructorPattern   _ _ ts) = qfv m ts
-  qfv m (InfixPattern      _ t1 _ t2) = qfv m [t1, t2]
-  qfv m (ParenPattern              t) = qfv m t
-  qfv m (RecordPattern        _ _ fs) = qfv m fs
-  qfv m (TuplePattern             ts) = qfv m ts
-  qfv m (ListPattern            _ ts) = qfv m ts
-  qfv m (AsPattern              _ ts) = qfv m ts
-  qfv m (LazyPattern               t) = qfv m t
-  qfv m (FunctionPattern      _ f ts)
+  qfv _ (LiteralPattern          _ _ _) = []
+  qfv _ (NegativePattern         _ _ _) = []
+  qfv _ (VariablePattern         _ _ _) = []
+  qfv m (ConstructorPattern   _ _ _ ts) = qfv m ts
+  qfv m (InfixPattern      _ _ t1 _ t2) = qfv m [t1, t2]
+  qfv m (ParenPattern              _ t) = qfv m t
+  qfv m (RecordPattern        _ _ _ fs) = qfv m fs
+  qfv m (TuplePattern             _ ts) = qfv m ts
+  qfv m (ListPattern            _ _ ts) = qfv m ts
+  qfv m (AsPattern              _ _ ts) = qfv m ts
+  qfv m (LazyPattern               _ t) = qfv m t
+  qfv m (FunctionPattern      _ _ f ts)
     = maybe [] return (localIdent m f) ++ qfv m ts
-  qfv m (InfixFuncPattern _ t1 op t2)
+  qfv m (InfixFuncPattern _ _ t1 op t2)
     = maybe [] return (localIdent m op) ++ qfv m [t1, t2]
 
 instance Expr Constraint where
-  fv (Constraint _ ty) = fv ty
+  fv (Constraint _ _ ty) = fv ty
 
 instance QuantExpr Constraint where
   bv _ = []
 
 instance Expr QualTypeExpr where
-  fv (QualTypeExpr _ ty) = fv ty
+  fv (QualTypeExpr _ _ ty) = fv ty
 
 instance QuantExpr QualTypeExpr where
-  bv (QualTypeExpr _ ty) = bv ty
+  bv (QualTypeExpr _ _ ty) = bv ty
 
 instance Expr TypeExpr where
-  fv (ConstructorType     _) = []
-  fv (ApplyType     ty1 ty2) = fv ty1 ++ fv ty2
-  fv (VariableType       tv) = [tv]
-  fv (TupleType         tys) = fv tys
-  fv (ListType           ty) = fv ty
-  fv (ArrowType     ty1 ty2) = fv ty1 ++ fv ty2
-  fv (ParenType          ty) = fv ty
-  fv (ForallType      vs ty) = filter (`notElem` vs) $ fv ty
+  fv (ConstructorType     _ _) = []
+  fv (ApplyType     _ ty1 ty2) = fv ty1 ++ fv ty2
+  fv (VariableType       _ tv) = [tv]
+  fv (TupleType         _ tys) = fv tys
+  fv (ListType          _  ty) = fv ty
+  fv (ArrowType     _ ty1 ty2) = fv ty1 ++ fv ty2
+  fv (ParenType          _ ty) = fv ty
+  fv (ForallType      _ vs ty) = filter (`notElem` vs) $ fv ty
 
 instance QuantExpr TypeExpr where
-  bv (ConstructorType     _) = []
-  bv (ApplyType     ty1 ty2) = bv ty1 ++ bv ty2
-  bv (VariableType        _) = []
-  bv (TupleType         tys) = bv tys
-  bv (ListType           ty) = bv ty
-  bv (ArrowType     ty1 ty2) = bv ty1 ++ bv ty2
-  bv (ParenType          ty) = bv ty
-  bv (ForallType     tvs ty) = tvs ++ bv ty
+  bv (ConstructorType     _ _) = []
+  bv (ApplyType     _ ty1 ty2) = bv ty1 ++ bv ty2
+  bv (VariableType        _ _) = []
+  bv (TupleType         _ tys) = bv tys
+  bv (ListType           _ ty) = bv ty
+  bv (ArrowType     _ ty1 ty2) = bv ty1 ++ bv ty2
+  bv (ParenType          _ ty) = bv ty
+  bv (ForallType     _ tvs ty) = tvs ++ bv ty
 
 filterBv :: QuantExpr e => e -> [Ident] -> [Ident]
 filterBv e = filter (`Set.notMember` Set.fromList (bv e))
diff --git a/src/Base/PrettyTypes.hs b/src/Base/PrettyTypes.hs
--- a/src/Base/PrettyTypes.hs
+++ b/src/Base/PrettyTypes.hs
@@ -10,8 +10,12 @@
 
    TODO
 -}
-
+{-# LANGUAGE CPP #-}
 module Base.PrettyTypes where
+
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
 
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set (Set, toAscList)
diff --git a/src/Base/Typing.hs b/src/Base/Typing.hs
--- a/src/Base/Typing.hs
+++ b/src/Base/Typing.hs
@@ -46,57 +46,57 @@
   typeOf = unpredType
 
 instance Typeable a => Typeable (Rhs a) where
-  typeOf (SimpleRhs _ e _) = typeOf e
-  typeOf (GuardedRhs es _) = head [typeOf e | CondExpr _ _ e <- es]
+  typeOf (SimpleRhs  _ e _ ) = typeOf e
+  typeOf (GuardedRhs _ es _) = head [typeOf e | CondExpr _ _ e <- es]
 
 instance Typeable a => Typeable (Pattern a) where
-  typeOf (LiteralPattern a _) = typeOf a
-  typeOf (NegativePattern a _) = typeOf a
-  typeOf (VariablePattern a _) = typeOf a
-  typeOf (ConstructorPattern a _ _) = typeOf a
-  typeOf (InfixPattern a _ _ _) = typeOf a
-  typeOf (ParenPattern t) = typeOf t
-  typeOf (RecordPattern a _ _) = typeOf a
-  typeOf (TuplePattern ts) = tupleType $ map typeOf ts
-  typeOf (ListPattern a _) = typeOf a
-  typeOf (AsPattern _ t) = typeOf t
-  typeOf (LazyPattern t) = typeOf t
-  typeOf (FunctionPattern a _ _) = typeOf a
-  typeOf (InfixFuncPattern a _ _ _) = typeOf a
+  typeOf (LiteralPattern _ a _) = typeOf a
+  typeOf (NegativePattern _ a _) = typeOf a
+  typeOf (VariablePattern _ a _) = typeOf a
+  typeOf (ConstructorPattern _ a _ _) = typeOf a
+  typeOf (InfixPattern _ a _ _ _) = typeOf a
+  typeOf (ParenPattern _ t) = typeOf t
+  typeOf (RecordPattern _ a _ _) = typeOf a
+  typeOf (TuplePattern _ ts) = tupleType $ map typeOf ts
+  typeOf (ListPattern _ a _) = typeOf a
+  typeOf (AsPattern _ _ t) = typeOf t
+  typeOf (LazyPattern _ t) = typeOf t
+  typeOf (FunctionPattern _ a _ _) = typeOf a
+  typeOf (InfixFuncPattern _ a _ _ _) = typeOf a
 
 instance Typeable a => Typeable (Expression a) where
-  typeOf (Literal a _) = typeOf a
-  typeOf (Variable a _) = typeOf a
-  typeOf (Constructor a _) = typeOf a
-  typeOf (Paren e) = typeOf e
-  typeOf (Typed e _) = typeOf e
-  typeOf (Record a _ _) = typeOf a
-  typeOf (RecordUpdate e _) = typeOf e
-  typeOf (Tuple es) = tupleType (map typeOf es)
-  typeOf (List a _) = typeOf a
-  typeOf (ListCompr e _) = listType (typeOf e)
-  typeOf (EnumFrom e) = listType (typeOf e)
-  typeOf (EnumFromThen e _) = listType (typeOf e)
-  typeOf (EnumFromTo e _) = listType (typeOf e)
-  typeOf (EnumFromThenTo e _ _) = listType (typeOf e)
-  typeOf (UnaryMinus e) = typeOf e
-  typeOf (Apply e _) = case typeOf e of
+  typeOf (Literal _ a _) = typeOf a
+  typeOf (Variable _ a _) = typeOf a
+  typeOf (Constructor _ a _) = typeOf a
+  typeOf (Paren _ e) = typeOf e
+  typeOf (Typed _ e _) = typeOf e
+  typeOf (Record _ a _ _) = typeOf a
+  typeOf (RecordUpdate _ e _) = typeOf e
+  typeOf (Tuple _ es) = tupleType (map typeOf es)
+  typeOf (List _ a _) = typeOf a
+  typeOf (ListCompr _ e _) = listType (typeOf e)
+  typeOf (EnumFrom _ e) = listType (typeOf e)
+  typeOf (EnumFromThen _ e _) = listType (typeOf e)
+  typeOf (EnumFromTo _ e _) = listType (typeOf e)
+  typeOf (EnumFromThenTo _ e _ _) = listType (typeOf e)
+  typeOf (UnaryMinus _ e) = typeOf e
+  typeOf (Apply _ e _) = case typeOf e of
     TypeArrow _ ty -> ty
     _ -> internalError "Base.Typing.typeOf: application"
-  typeOf (InfixApply _ op _) = case typeOf (infixOp op) of
+  typeOf (InfixApply _ _ op _) = case typeOf (infixOp op) of
     TypeArrow _ (TypeArrow _ ty) -> ty
     _ -> internalError "Base.Typing.typeOf: infix application"
-  typeOf (LeftSection _ op) = case typeOf (infixOp op) of
+  typeOf (LeftSection _ _ op) = case typeOf (infixOp op) of
     TypeArrow _ ty -> ty
     _ -> internalError "Base.Typing.typeOf: left section"
-  typeOf (RightSection op _) = case typeOf (infixOp op) of
+  typeOf (RightSection _ op _) = case typeOf (infixOp op) of
     TypeArrow ty1 (TypeArrow _ ty2) -> TypeArrow ty1 ty2
     _ -> internalError "Base.Typing.typeOf: right section"
-  typeOf (Lambda ts e) = foldr (TypeArrow . typeOf) (typeOf e) ts
-  typeOf (Let _ e) = typeOf e
-  typeOf (Do _ e) = typeOf e
-  typeOf (IfThenElse _ e _) = typeOf e
-  typeOf (Case _ _ as) = typeOf $ head as
+  typeOf (Lambda _ ts e) = foldr (TypeArrow . typeOf) (typeOf e) ts
+  typeOf (Let _ _ e) = typeOf e
+  typeOf (Do _ _ e) = typeOf e
+  typeOf (IfThenElse _ _ e _) = typeOf e
+  typeOf (Case _ _ _ as) = typeOf $ head as
 
 instance Typeable a => Typeable (Alt a) where
   typeOf (Alt _ _ rhs) = typeOf rhs
@@ -174,19 +174,19 @@
 declVars _                          = internalError "Base.Typing.declVars"
 
 patternVars :: (Eq t, Typeable t, ValueType t) => Pattern t -> [(Ident, Int, t)]
-patternVars (LiteralPattern         _ _) = []
-patternVars (NegativePattern        _ _) = []
-patternVars (VariablePattern       ty v) = [(v, 0, ty)]
-patternVars (ConstructorPattern  _ _ ts) = concatMap patternVars ts
-patternVars (InfixPattern     _ t1 _ t2) = patternVars t1 ++ patternVars t2
-patternVars (ParenPattern             t) = patternVars t
-patternVars (RecordPattern       _ _ fs) =
+patternVars (LiteralPattern         _ _ _) = []
+patternVars (NegativePattern        _ _ _) = []
+patternVars (VariablePattern       _ ty v) = [(v, 0, ty)]
+patternVars (ConstructorPattern  _ _ _ ts) = concatMap patternVars ts
+patternVars (InfixPattern     _ _ t1 _ t2) = patternVars t1 ++ patternVars t2
+patternVars (ParenPattern             _ t) = patternVars t
+patternVars (RecordPattern       _ _ _ fs) =
   concat [patternVars t | Field _ _ t <- fs]
-patternVars (TuplePattern            ts) = concatMap patternVars ts
-patternVars (ListPattern           _ ts) = concatMap patternVars ts
-patternVars (AsPattern              v t) =
+patternVars (TuplePattern            _ ts) = concatMap patternVars ts
+patternVars (ListPattern           _ _ ts) = concatMap patternVars ts
+patternVars (AsPattern              _ v t) =
   (v, 0, toValueType $ typeOf t) : patternVars t
-patternVars (LazyPattern              t) = patternVars t
-patternVars (FunctionPattern     _ _ ts) = nub $ concatMap patternVars ts
-patternVars (InfixFuncPattern _ t1 _ t2) =
+patternVars (LazyPattern              _ t) = patternVars t
+patternVars (FunctionPattern     _ _ _ ts) = nub $ concatMap patternVars ts
+patternVars (InfixFuncPattern _ _ t1 _ t2) =
   nub $ patternVars t1 ++ patternVars t2
diff --git a/src/Checks.hs b/src/Checks.hs
--- a/src/Checks.hs
+++ b/src/Checks.hs
@@ -103,8 +103,8 @@
 --                 precedences
 -- * Environment:  The operator precedence environment is updated
 precCheck :: Monad m => Check m (Module a)
-precCheck _ (env, Module ps m es is ds)
-  | null msgs = ok (env { opPrecEnv = pEnv' }, Module ps m es is ds')
+precCheck _ (env, Module spi ps m es is ds)
+  | null msgs = ok (env { opPrecEnv = pEnv' }, Module spi ps m es is ds')
   | otherwise = failMessages msgs
   where (ds', pEnv', msgs) = PC.precCheck (moduleIdent env) (opPrecEnv env) ds
 
@@ -122,8 +122,8 @@
 -- * Declarations: remain unchanged
 -- * Environment:  The instance environment is updated
 instanceCheck :: Monad m => Check m (Module a)
-instanceCheck _ (env, Module ps m es is ds)
-  | null msgs = ok (env { instEnv = inEnv' }, Module ps m es is ds)
+instanceCheck _ (env, Module spi ps m es is ds)
+  | null msgs = ok (env { instEnv = inEnv' }, Module spi ps m es is ds)
   | otherwise = failMessages msgs
   where (inEnv', msgs) = INC.instanceCheck (moduleIdent env) (tyConsEnv env)
                                            (classEnv env) (instEnv env) ds
@@ -134,8 +134,8 @@
 -- * Environment:  The value environment is updated.
 typeCheck :: Monad m => Options -> CompEnv (Module a)
           -> CYT m (CompEnv (Module PredType))
-typeCheck _ (env, Module ps m es is ds)
-  | null msgs = ok (env { valueEnv = vEnv' }, Module ps m es is ds')
+typeCheck _ (env, Module spi ps m es is ds)
+  | null msgs = ok (env { valueEnv = vEnv' }, Module spi ps m es is ds')
   | otherwise = failMessages msgs
   where (ds', vEnv', msgs) = TC.typeCheck (moduleIdent env) (tyConsEnv env)
                                           (valueEnv env) (classEnv env)
@@ -143,7 +143,7 @@
 
 -- |Check the export specification
 exportCheck :: Monad m => Check m (Module a)
-exportCheck _ (env, mdl@(Module _ _ es _ _))
+exportCheck _ (env, mdl@(Module _ _ _ es _ _))
   | null msgs = ok (env, mdl)
   | otherwise = failMessages msgs
   where msgs = EC.exportCheck (moduleIdent env) (aliasEnv env)
@@ -151,8 +151,8 @@
 
 -- |Check the export specification
 expandExports :: Monad m => Options -> CompEnv (Module a) -> m (CompEnv (Module a))
-expandExports _ (env, Module ps m es is ds)
-  = return (env, Module ps m (Just es') is ds)
+expandExports _ (env, Module spi ps m es is ds)
+  = return (env, Module spi ps m (Just es') is ds)
   where es' = EC.expandExports (moduleIdent env) (aliasEnv env)
                                (tyConsEnv env) (valueEnv env) es
 
diff --git a/src/Checks/DeriveCheck.hs b/src/Checks/DeriveCheck.hs
--- a/src/Checks/DeriveCheck.hs
+++ b/src/Checks/DeriveCheck.hs
@@ -24,7 +24,7 @@
 import Env.TypeConstructor
 
 deriveCheck :: TCEnv -> Module a -> [Message]
-deriveCheck tcEnv (Module _ m _ _ ds) = concatMap (checkDecl m tcEnv) ds
+deriveCheck tcEnv (Module _ _ m _ _ ds) = concatMap (checkDecl m tcEnv) ds
 
 -- No instances can be derived for abstract data types as well as for
 -- existential data types.
diff --git a/src/Checks/ExportCheck.hs b/src/Checks/ExportCheck.hs
--- a/src/Checks/ExportCheck.hs
+++ b/src/Checks/ExportCheck.hs
@@ -26,6 +26,10 @@
 {-# LANGUAGE CPP #-}
 module Checks.ExportCheck (exportCheck, expandExports) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative        ((<$>))
 #endif
@@ -40,6 +44,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Pretty
 import Curry.Syntax
 
@@ -64,10 +69,10 @@
 
 expandExports :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv
               -> Maybe ExportSpec -> ExportSpec
-expandExports m aEnv tcEnv tyEnv spec = Exporting (exportPos spec) es
+expandExports m aEnv tcEnv tyEnv spec = Exporting (exportSpan spec) es
   where
-  exportPos (Just (Exporting p _)) = p
-  exportPos Nothing                = NoPos
+  exportSpan (Just (Exporting spi _)) = spi
+  exportSpan Nothing                  = NoSpanInfo
 
   es = expand m aEnv tcEnv tyEnv spec
 
@@ -131,10 +136,10 @@
 
 -- |Check single export.
 checkExport :: Export -> ECM ()
-checkExport (Export         x    ) = checkThing x
-checkExport (ExportTypeWith tc cs) = checkTypeWith tc cs
-checkExport (ExportTypeAll  tc   ) = checkTypeAll tc
-checkExport (ExportModule   em   ) = checkModule em
+checkExport (Export         _ x    ) = checkThing x
+checkExport (ExportTypeWith _ tc cs) = checkTypeWith tc cs
+checkExport (ExportTypeAll  _ tc   ) = checkTypeAll tc
+checkExport (ExportModule   _ em   ) = checkModule em
 
 -- |Check export of type constructor / function
 checkThing :: QualIdent -> ECM ()
@@ -143,7 +148,7 @@
   tcEnv <- getTyConsEnv
   case qualLookupTypeInfoUnique m tc tcEnv of
     []  -> checkThing' tc Nothing
-    [t] -> checkThing' tc (Just [ExportTypeWith (origName t) []])
+    [t] -> checkThing' tc (Just [ExportTypeWith NoSpanInfo (origName t) []])
     ts  -> report (errAmbiguousType tc ts)
 
 -- |Expand export of data cons / function
@@ -226,9 +231,9 @@
 checkNonUniqueness es = map errMultipleType (findMultiples types )
                      ++ map errMultipleName (findMultiples values)
   where
-  types  = [ unqualify tc | ExportTypeWith tc _  <- es ]
-  values = [ c            | ExportTypeWith _  cs <- es, c <- cs ]
-        ++ [ unqualify f  | Export f <- es ]
+  types  = [ unqualify tc | ExportTypeWith _ tc _  <- es ]
+  values = [ c            | ExportTypeWith _ _  cs <- es, c <- cs ]
+        ++ [ unqualify f  | Export _ f <- es ]
 
 -- -----------------------------------------------------------------------------
 -- Expansion
@@ -262,10 +267,10 @@
 
 -- |Expand single export
 expandExport :: Export -> ECM [Export]
-expandExport (Export             x) = expandThing x
-expandExport (ExportTypeWith tc cs) = expandTypeWith tc cs
-expandExport (ExportTypeAll     tc) = expandTypeAll tc
-expandExport (ExportModule      em) = expandModule em
+expandExport (Export             _ x) = expandThing x
+expandExport (ExportTypeWith _ tc cs) = expandTypeWith tc cs
+expandExport (ExportTypeAll     _ tc) = expandTypeAll tc
+expandExport (ExportModule      _ em) = expandModule em
 
 -- |Expand export of type constructor / function
 expandThing :: QualIdent -> ECM [Export]
@@ -274,7 +279,8 @@
   tcEnv <- getTyConsEnv
   case qualLookupTypeInfoUnique m tc tcEnv of
     []  -> expandThing' tc Nothing
-    [t] -> expandThing' tc (Just [ExportTypeWith (origName t @> tc) []])
+    [t] -> expandThing' tc
+             (Just [ExportTypeWith NoSpanInfo (origName t @> tc) []])
     err -> internalError $ currentModuleName ++ ".expandThing: " ++ show err
 
 -- |Expand export of data cons / function
@@ -283,8 +289,10 @@
   m     <- getModuleIdent
   tyEnv <- getValueEnv
   case qualLookupValueUnique m f tyEnv of
-    [Value f' _ _ _] -> return $ Export (f' @> f) : fromMaybe [] tcExport
-    _                -> return $ fromMaybe [] tcExport
+    [Value f' _ _ _]
+      -> return $ Export NoSpanInfo (f' @> f) : fromMaybe [] tcExport
+    _
+      -> return $ fromMaybe [] tcExport
 
 -- |Expand type constructor with explicit data constructors and record labels
 expandTypeWith :: QualIdent -> [Ident] -> ECM [Export]
@@ -292,7 +300,7 @@
   m     <- getModuleIdent
   tcEnv <- getTyConsEnv
   case qualLookupTypeInfoUnique m tc tcEnv of
-    [t] -> return [ExportTypeWith (origName t @> tc) $ nub xs]
+    [t] -> return [ExportTypeWith NoSpanInfo (origName t @> tc) $ nub xs]
     err -> internalError $ currentModuleName ++ ".expandTypeWith: " ++ show err
 
 -- |Expand type constructor with all data constructors and record labels
@@ -318,8 +326,10 @@
   tyEnv <- getValueEnv
   return $
        [ exportType t | (_, t) <- localBindings tcEnv ]
-    ++ [ Export f' | (f, Value f' _ _ _) <- localBindings tyEnv, hasGlobalScope f ]
-    ++ [ Export l' | (l, Label l' _ _) <- localBindings tyEnv, hasGlobalScope l ]
+    ++ [ Export NoSpanInfo f'
+         | (f, Value f' _ _ _) <- localBindings tyEnv, hasGlobalScope f ]
+    ++ [ Export NoSpanInfo l'
+         | (l, Label l' _ _)   <- localBindings tyEnv, hasGlobalScope l ]
 
 -- |Expand a module export
 expandImportedModule :: ModuleIdent -> ECM [Export]
@@ -327,11 +337,11 @@
   tcEnv <- getTyConsEnv
   tyEnv <- getValueEnv
   return $ [exportType t |       (_, t) <- moduleImports m tcEnv]
-        ++ [Export f | (_, Value f _ _ _) <- moduleImports m tyEnv]
-        ++ [Export l | (_, Label l _ _) <- moduleImports m tyEnv]
+        ++ [Export NoSpanInfo f | (_, Value f _ _ _) <- moduleImports m tyEnv]
+        ++ [Export NoSpanInfo l | (_, Label l _ _)   <- moduleImports m tyEnv]
 
 exportType :: TypeInfo -> Export
-exportType t = ExportTypeWith tc xs
+exportType t = ExportTypeWith NoSpanInfo tc xs
   where tc = origName t
         xs = elements t
 
@@ -353,21 +363,23 @@
 canonExports tcEnv es = map (canonExport (canonLabels tcEnv es)) es
 
 canonExport :: Map.Map QualIdent Export -> Export -> Export
-canonExport ls (Export x)             = fromMaybe (Export x) (Map.lookup x ls)
-canonExport _  (ExportTypeWith tc xs) = ExportTypeWith tc xs
-canonExport _  e                      = internalError $
+canonExport ls (Export spi x)             =
+  fromMaybe (Export spi x) (Map.lookup x ls)
+canonExport _  (ExportTypeWith spi tc xs) = ExportTypeWith spi tc xs
+canonExport _  e                          = internalError $
   currentModuleName ++ ".canonExport: " ++ show e
 
 canonLabels :: TCEnv -> [Export] -> Map.Map QualIdent Export
 canonLabels tcEnv es = foldr bindLabels Map.empty (allEntities tcEnv)
   where
-  tcs = [tc | ExportTypeWith tc _ <- es]
+  tcs = [tc | ExportTypeWith _ tc _ <- es]
   bindLabels t ls
     | tc' `elem` tcs = foldr (bindLabel tc') ls (elements t)
     | otherwise     = ls
       where
         tc'            = origName t
-        bindLabel tc x = Map.insert (qualifyLike tc x) (ExportTypeWith tc [x])
+        bindLabel tc x =
+          Map.insert (qualifyLike tc x) (ExportTypeWith NoSpanInfo tc [x])
 
 -- The expanded list of exported entities may contain duplicates. These
 -- are removed by the function joinExports. In particular, this
@@ -375,21 +387,21 @@
 -- which are also exported along with their types.
 
 joinExports :: [Export] -> [Export]
-joinExports es =  [ExportTypeWith tc cs | (tc, cs) <- joinedTypes]
-               ++ [Export f             | f        <- joinedFuncs]
+joinExports es =  [ExportTypeWith NoSpanInfo tc cs | (tc, cs) <- joinedTypes]
+               ++ [Export NoSpanInfo f             | f        <- joinedFuncs]
   where joinedTypes = Map.toList $ foldr joinType Map.empty es
         joinedFuncs = Set.toList $ foldr joinFun  Set.empty es
 
 joinType :: Export -> Map.Map QualIdent [Ident] -> Map.Map QualIdent [Ident]
-joinType (Export             _) tcs = tcs
-joinType (ExportTypeWith tc cs) tcs = Map.insertWith union tc cs tcs
-joinType export                   _ = internalError $
+joinType (Export             _ _) tcs = tcs
+joinType (ExportTypeWith _ tc cs) tcs = Map.insertWith union tc cs tcs
+joinType export                     _ = internalError $
   currentModuleName ++ ".joinType: " ++ show export
 
 joinFun :: Export -> Set.Set QualIdent -> Set.Set QualIdent
-joinFun (Export           f) fs = f `Set.insert` fs
-joinFun (ExportTypeWith _ _) fs = fs
-joinFun export                _ = internalError $
+joinFun (Export           _ f) fs = f `Set.insert` fs
+joinFun (ExportTypeWith _ _ _) fs = fs
+joinFun export                  _ = internalError $
   currentModuleName ++ ".joinFun: " ++ show export
 
 -- ---------------------------------------------------------------------------
@@ -444,7 +456,7 @@
 errMultiple what (i:is) = posMessage i $
   text "Multiple exports of" <+> text what <+> text (escName i) <+> text "at:"
   $+$ nest 2 (vcat (map showPos (i:is)))
-  where showPos = text . showLine . idPosition
+  where showPos = text . showLine . getPosition
 
 errNonDataTypeOrTypeClass :: QualIdent -> Message
 errNonDataTypeOrTypeClass tc = posMessage tc $ hsep $ map text
diff --git a/src/Checks/ExtensionCheck.hs b/src/Checks/ExtensionCheck.hs
--- a/src/Checks/ExtensionCheck.hs
+++ b/src/Checks/ExtensionCheck.hs
@@ -50,10 +50,10 @@
 
 -- The extension check iterates over all given pragmas in the module and
 -- gathers all extensions mentioned in a language pragma. An error is reported
--- if an extension is unkown.
+-- if an extension is unknown.
 
 checkModule :: Module a -> EXCM ()
-checkModule (Module ps _ _ _ _) = mapM_ checkPragma ps
+checkModule (Module _ ps _ _ _ _) = mapM_ checkPragma ps
 
 checkPragma :: ModulePragma -> EXCM ()
 checkPragma (LanguagePragma _ exts) = mapM_ checkExtension exts
diff --git a/src/Checks/ImportSyntaxCheck.hs b/src/Checks/ImportSyntaxCheck.hs
--- a/src/Checks/ImportSyntaxCheck.hs
+++ b/src/Checks/ImportSyntaxCheck.hs
@@ -22,6 +22,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Pretty
+import Curry.Base.SpanInfo
 import Curry.Syntax hiding (Var (..))
 
 import Base.Messages
@@ -174,26 +175,26 @@
 expandSpecs (Just (Hiding    p is)) = (Just . Hiding    p . concat) `liftM` mapM expandHiding is
 
 expandImport :: Import -> ExpandM [Import]
-expandImport (Import             x) =               expandThing    x
-expandImport (ImportTypeWith tc cs) = (:[]) `liftM` expandTypeWith tc cs
-expandImport (ImportTypeAll     tc) = (:[]) `liftM` expandTypeAll  tc
+expandImport (Import         spi x    ) =               expandThing    spi x
+expandImport (ImportTypeWith spi tc cs) = (:[]) `liftM` expandTypeWith spi tc cs
+expandImport (ImportTypeAll  spi tc   ) = (:[]) `liftM` expandTypeAll  spi tc
 
 expandHiding :: Import -> ExpandM [Import]
-expandHiding (Import             x) = expandHide x
-expandHiding (ImportTypeWith tc cs) = (:[]) `liftM` expandTypeWith tc cs
-expandHiding (ImportTypeAll     tc) = (:[]) `liftM` expandTypeAll  tc
+expandHiding (Import         spi x    ) = expandHide spi x
+expandHiding (ImportTypeWith spi tc cs) = (:[]) `liftM` expandTypeWith spi tc cs
+expandHiding (ImportTypeAll  spi tc   ) = (:[]) `liftM` expandTypeAll  spi tc
 
 -- try to expand as type constructor
-expandThing :: Ident -> ExpandM [Import]
-expandThing tc = do
+expandThing :: SpanInfo -> Ident -> ExpandM [Import]
+expandThing spi tc = do
   tcEnv <- getTyConsEnv
   case Map.lookup tc tcEnv of
-    Just _  -> expandThing' tc $ Just [ImportTypeWith tc []]
-    Nothing -> expandThing' tc Nothing
+    Just _  -> expandThing' spi tc $ Just [ImportTypeWith spi tc []]
+    Nothing -> expandThing' spi tc Nothing
 
 -- try to expand as function / data constructor
-expandThing' :: Ident -> Maybe [Import] -> ExpandM [Import]
-expandThing' f tcImport = do
+expandThing' :: SpanInfo -> Ident -> Maybe [Import] -> ExpandM [Import]
+expandThing' spi f tcImport = do
   m     <- getModuleIdent
   tyEnv <- getValueEnv
   expand m f (Map.lookup f tyEnv) tcImport
@@ -206,35 +207,35 @@
     | isConstr v = case maybeTc of
         Nothing -> report (errImportDataConstr m e) >> return []
         Just tc -> return tc
-    | otherwise  = return [Import e]
+    | otherwise  = return [Import spi e]
 
   isConstr (Constr _) = True
   isConstr (Var  _ _) = False
 
 -- try to hide as type constructor
-expandHide :: Ident -> ExpandM [Import]
-expandHide tc = do
+expandHide :: SpanInfo -> Ident -> ExpandM [Import]
+expandHide spi tc = do
   tcEnv <- getTyConsEnv
   case Map.lookup tc tcEnv of
-    Just _  -> expandHide' tc $ Just [ImportTypeWith tc []]
-    Nothing -> expandHide' tc Nothing
+    Just _  -> expandHide' spi tc $ Just [ImportTypeWith spi tc []]
+    Nothing -> expandHide' spi tc Nothing
 
 -- try to hide as function / data constructor
-expandHide' :: Ident -> Maybe [Import] -> ExpandM [Import]
-expandHide' f tcImport = do
+expandHide' :: SpanInfo -> Ident -> Maybe [Import] -> ExpandM [Import]
+expandHide' spi f tcImport = do
   m     <- getModuleIdent
   tyEnv <- getValueEnv
   case Map.lookup f tyEnv of
-    Just _  -> return $ Import f : fromMaybe [] tcImport
+    Just _  -> return $ Import spi f : fromMaybe [] tcImport
     Nothing -> case tcImport of
       Nothing -> report (errUndefinedEntity m f) >> return []
       Just tc -> return tc
 
-expandTypeWith ::  Ident -> [Ident] -> ExpandM Import
-expandTypeWith tc cs = do
+expandTypeWith :: SpanInfo -> Ident -> [Ident] -> ExpandM Import
+expandTypeWith spi tc cs = do
   m     <- getModuleIdent
   tcEnv <- getTyConsEnv
-  ImportTypeWith tc `liftM` case Map.lookup tc tcEnv of
+  ImportTypeWith spi tc `liftM` case Map.lookup tc tcEnv of
     Just (Data  _ xs) -> mapM (checkElement errUndefinedElement xs) cs
     Just (Class _ xs) -> mapM (checkElement errUndefinedMethod  xs) cs
     Just (Alias    _) -> report (errNonDataTypeOrTypeClass tc) >> return []
@@ -245,11 +246,11 @@
     unless (c `elem` cs') $ report $ err tc c
     return c
 
-expandTypeAll :: Ident -> ExpandM Import
-expandTypeAll tc = do
+expandTypeAll :: SpanInfo -> Ident -> ExpandM Import
+expandTypeAll spi tc = do
   m     <- getModuleIdent
   tcEnv <- getTyConsEnv
-  ImportTypeWith tc `liftM` case Map.lookup tc tcEnv of
+  ImportTypeWith spi tc `liftM` case Map.lookup tc tcEnv of
     Just (Data _  xs) -> return xs
     Just (Class _ xs) -> return xs
     Just (Alias    _) -> report (errNonDataTypeOrTypeClass tc) >> return []
diff --git a/src/Checks/InstanceCheck.hs b/src/Checks/InstanceCheck.hs
--- a/src/Checks/InstanceCheck.hs
+++ b/src/Checks/InstanceCheck.hs
@@ -28,6 +28,7 @@
 import Curry.Base.Ident
 import Curry.Base.Position
 import Curry.Base.Pretty
+import Curry.Base.SpanInfo
 import Curry.Syntax hiding (impls)
 import Curry.Syntax.Pretty
 
@@ -108,7 +109,8 @@
 bindInstance :: TCEnv -> ClassEnv -> Decl a -> INCM ()
 bindInstance tcEnv clsEnv (InstanceDecl _ cx qcls inst ds) = do
   m <- getModuleIdent
-  let PredType ps _ = expandPolyType m tcEnv clsEnv $ QualTypeExpr cx inst
+  let PredType ps _ = expandPolyType m tcEnv clsEnv $
+                        QualTypeExpr NoSpanInfo cx inst
   modifyInstEnv $
     bindInstInfo (genInstIdent m tcEnv qcls inst) (m, ps, impls [] ds)
   where impls is [] = is
@@ -149,15 +151,16 @@
 declDeriveInfo _ _ _ =
   internalError "InstanceCheck.declDeriveInfo: no data or newtype declaration"
 
-mkDeriveInfo :: TCEnv -> ClassEnv -> Position -> Ident -> [Ident] -> Context
+mkDeriveInfo :: TCEnv -> ClassEnv -> SpanInfo -> Ident -> [Ident] -> Context
            -> [TypeExpr] -> [QualIdent] -> INCM DeriveInfo
-mkDeriveInfo tcEnv clsEnv p tc tvs cx tys clss = do
+mkDeriveInfo tcEnv clsEnv spi tc tvs cx tys clss = do
   m <- getModuleIdent
   let otc = qualifyWith m tc
       oclss = map (flip (getOrigName m) tcEnv) clss
       PredType ps ty = expandConstrType m tcEnv clsEnv otc tvs cx tys
       (tys', ty') = arrowUnapply ty
   return $ DeriveInfo p otc (PredType ps ty') tys' $ sortClasses clsEnv oclss
+  where p = spanInfo2Pos spi
 
 sortClasses :: ClassEnv -> [QualIdent] -> [QualIdent]
 sortClasses clsEnv clss = map fst $ sortBy compareDepth $ map adjoinDepth clss
@@ -248,9 +251,10 @@
 -- satisfied by cx.
 
 checkInstance :: TCEnv -> ClassEnv -> Decl a -> INCM ()
-checkInstance tcEnv clsEnv (InstanceDecl p cx cls inst _) = do
+checkInstance tcEnv clsEnv (InstanceDecl spi cx cls inst _) = do
   m <- getModuleIdent
-  let PredType ps ty = expandPolyType m tcEnv clsEnv $ QualTypeExpr cx inst
+  let PredType ps ty = expandPolyType m tcEnv clsEnv $
+                         QualTypeExpr NoSpanInfo cx inst
       ocls = getOrigName m cls tcEnv
       ps' = Set.fromList [ Pred scls ty | scls <- superClasses ocls clsEnv ]
       doc = ppPred m $ Pred cls ty
@@ -258,6 +262,7 @@
   ps'' <- reducePredSet p what doc clsEnv ps'
   Set.mapM_ (report . errMissingInstance m p what doc) $
     ps'' `Set.difference` (maxPredSet clsEnv ps)
+  where p = spanInfo2Pos spi
 checkInstance _ _ _ = ok
 
 -- All types specified in the optional default declaration of a module
@@ -267,13 +272,14 @@
 
 checkDefault :: TCEnv -> ClassEnv -> Decl a -> INCM ()
 checkDefault tcEnv clsEnv (DefaultDecl p tys) =
-  mapM_ (checkDefaultType p tcEnv clsEnv) tys
+  mapM_ (checkDefaultType (spanInfo2Pos p) tcEnv clsEnv) tys
 checkDefault _ _ _ = ok
 
 checkDefaultType :: Position -> TCEnv -> ClassEnv -> TypeExpr -> INCM ()
 checkDefaultType p tcEnv clsEnv ty = do
   m <- getModuleIdent
-  let PredType _ ty' = expandPolyType m tcEnv clsEnv $ QualTypeExpr [] ty
+  let PredType _ ty' = expandPolyType m tcEnv clsEnv $
+                         QualTypeExpr NoSpanInfo [] ty
   ps <- reducePredSet p what empty clsEnv (Set.singleton $ Pred qNumId ty')
   Set.mapM_ (report . errMissingInstance m p what empty) ps
   where what = "default declaration"
@@ -312,9 +318,11 @@
 
 genInstIdents :: ModuleIdent -> TCEnv -> Decl a -> [InstIdent]
 genInstIdents m tcEnv (DataDecl    _ tc _ _ qclss) =
-  map (flip (genInstIdent m tcEnv) $ ConstructorType $ qualify tc) qclss
+  map (flip (genInstIdent m tcEnv) $ ConstructorType NoSpanInfo $ qualify tc)
+      qclss
 genInstIdents m tcEnv (NewtypeDecl _ tc _ _ qclss) =
-  map (flip (genInstIdent m tcEnv) $ ConstructorType $ qualify tc) qclss
+  map (flip (genInstIdent m tcEnv) $ ConstructorType NoSpanInfo $ qualify tc)
+      qclss
 genInstIdents m tcEnv (InstanceDecl _ _ qcls ty _) =
   [genInstIdent m tcEnv qcls ty]
 genInstIdents _ _     _                            = []
diff --git a/src/Checks/InterfaceCheck.hs b/src/Checks/InterfaceCheck.hs
--- a/src/Checks/InterfaceCheck.hs
+++ b/src/Checks/InterfaceCheck.hs
@@ -55,6 +55,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Pretty
 import Curry.Syntax
 
@@ -150,20 +151,20 @@
 checkImport (IFunctionDecl p f (Just tv) n ty) = do
   m <- getModuleIdent
   let check (Value f' cm' n' (ForAll _ ty')) =
-        f == f' && True == cm' && n' == n && toQualPredType m [tv] ty == ty'
+        f == f' && cm' && n' == n && toQualPredType m [tv] ty == ty'
       check _ = False
   checkValueInfo "method" check p f
 checkImport (IFunctionDecl p f Nothing n ty) = do
   m <- getModuleIdent
   let check (Value f' cm' n' (ForAll _ ty')) =
-        f == f' && False == cm' && n' == n && toQualPredType m [] ty == ty'
+        f == f' && not cm' && n' == n && toQualPredType m [] ty == ty'
       check _ = False
   checkValueInfo "function" check p f
 checkImport (HidingClassDecl p cx cls k _) = do
   clsEnv <- getClassEnv
   let check (TypeClass cls' k' _)
         | cls == cls' && toKind' k 0 == k' &&
-          [cls'' | Constraint cls'' _ <- cx] == superClasses cls' clsEnv
+          [cls'' | Constraint _ cls'' _ <- cx] == superClasses cls' clsEnv
         = Just ok
       check _ = Nothing
   checkTypeInfo "hidden type class" check p cls
@@ -171,15 +172,15 @@
   clsEnv <- getClassEnv
   let check (TypeClass cls' k' fs)
         | cls == cls' && toKind' k 0 == k' &&
-          [cls'' | Constraint cls'' _ <- cx] == superClasses cls' clsEnv &&
+          [cls'' | Constraint _ cls'' _ <- cx] == superClasses cls' clsEnv &&
           map (\m -> (imethod m, imethodArity m)) ms ==
             map (\f -> (methodName f, methodArity f)) fs
         = Just $ mapM_ (checkMethodImport cls clsvar) ms
       check _ = Nothing
   checkTypeInfo "type class" check p cls
-checkImport (IInstanceDecl p cx cls ty is m) = do
+checkImport (IInstanceDecl p cx cls ty is m) =
   checkInstInfo check p (cls, typeConstr ty) m
-  where PredType ps _ = toPredType [] $ QualTypeExpr cx ty
+  where PredType ps _ = toPredType [] $ QualTypeExpr NoSpanInfo cx ty
         check ps' is' = ps == ps' && sort is == sort is'
 
 checkConstrImport :: QualIdent -> [Ident] -> ConstrDecl -> IC ()
@@ -231,7 +232,7 @@
   checkValueInfo "method" check p qf
   where qf = qualifyLike qcls f
         check (Value f' cm' _ (ForAll _ pty)) =
-          qf == f' && cm' == True && toMethodType qcls clsvar qty == pty
+          qf == f' && cm' && toMethodType qcls clsvar qty == pty
         check _ = False
 
 checkPrecInfo :: (PrecInfo -> Bool) -> Position -> QualIdent -> IC ()
@@ -266,19 +267,21 @@
         Nothing -> report $ errNoInstance p m i
   checkImported checkInfo (maybe qualify qualifyWith mm anonId)
 
-checkValueInfo :: String -> (ValueInfo -> Bool) -> Position
+checkValueInfo :: HasPosition a => String -> (ValueInfo -> Bool) -> a
                -> QualIdent -> IC ()
 checkValueInfo what check p x = do
   tyEnv <- getValueEnv
   let checkInfo m x' = case qualLookupTopEnv x tyEnv of
-        []   -> report $ errNotExported p what m x'
-        [vi] -> unless (check vi) (report $ errImportConflict p what m x')
+        []   -> report $ errNotExported p' what m x'
+        [vi] -> unless (check vi)
+                  (report $ errImportConflict p' what m x')
         _    -> internalError "checkValueInfo"
   checkImported checkInfo x
+  where p' = getPosition p
 
 checkImported :: (ModuleIdent -> Ident -> IC ()) -> QualIdent -> IC ()
-checkImported _ (QualIdent Nothing  _) = ok
-checkImported f (QualIdent (Just m) x) = f m x
+checkImported _ (QualIdent _ Nothing  _) = ok
+checkImported f (QualIdent _ (Just m) x) = f m x
 
 -- ---------------------------------------------------------------------------
 -- Error messages
diff --git a/src/Checks/InterfaceSyntaxCheck.hs b/src/Checks/InterfaceSyntaxCheck.hs
--- a/src/Checks/InterfaceSyntaxCheck.hs
+++ b/src/Checks/InterfaceSyntaxCheck.hs
@@ -38,6 +38,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Pretty
 import Curry.Syntax
 import Curry.Syntax.Pretty
@@ -121,7 +122,7 @@
   return $ IClassDecl p cx' qcls k clsvar ms' hs
 checkIDecl (IInstanceDecl p cx qcls inst is m) = do
   checkClass qcls
-  QualTypeExpr cx' inst' <- checkQualType $ QualTypeExpr cx inst
+  QualTypeExpr _ cx' inst' <- checkQualType $ QualTypeExpr NoSpanInfo cx inst
   checkSimpleContext cx'
   checkInstanceType p inst'
   mapM_ (report . errMultipleImplementation . head) $ findMultiples $ map fst is
@@ -183,14 +184,14 @@
 checkSimpleContext = mapM_ checkSimpleConstraint
 
 checkSimpleConstraint :: Constraint -> ISC ()
-checkSimpleConstraint c@(Constraint _ ty) =
+checkSimpleConstraint c@(Constraint _ _ ty) =
   unless (isVariableType ty) $ report $ errIllegalSimpleConstraint c
 
 checkIMethodDecl :: Ident -> IMethodDecl -> ISC IMethodDecl
 checkIMethodDecl tv (IMethodDecl p f a qty) = do
   qty' <- checkQualType qty
   unless (tv `elem` fv qty') $ report $ errAmbiguousType p tv
-  let QualTypeExpr cx _ = qty'
+  let QualTypeExpr _ cx _ = qty'
   when (tv `elem` fv cx) $ report $ errConstrainedClassVariable p tv
   return $ IMethodDecl p f a qty'
 
@@ -204,24 +205,24 @@
       report $ errIllegalInstanceType p inst
 
 checkQualType :: QualTypeExpr -> ISC QualTypeExpr
-checkQualType (QualTypeExpr cx ty) = do
+checkQualType (QualTypeExpr spi cx ty) = do
   ty' <- checkType ty
   cx' <- checkClosedContext (fv ty') cx
-  return $ QualTypeExpr cx' ty'
+  return $ QualTypeExpr spi cx' ty'
 
 checkClosedContext :: [Ident] -> Context -> ISC Context
 checkClosedContext tvs cx = do
   cx' <- checkContext cx
-  mapM_ (\(Constraint _ ty) -> checkClosed tvs ty) cx'
+  mapM_ (\(Constraint _ _ ty) -> checkClosed tvs ty) cx'
   return cx'
 
 checkContext :: Context -> ISC Context
 checkContext = mapM checkConstraint
 
 checkConstraint :: Constraint -> ISC Constraint
-checkConstraint (Constraint qcls ty) = do
+checkConstraint (Constraint spi qcls ty) = do
   checkClass qcls
-  Constraint qcls `liftM` checkType ty
+  Constraint spi qcls `liftM` checkType ty
 
 checkClass :: QualIdent -> ISC ()
 checkClass qcls = do
@@ -240,38 +241,41 @@
   return ty'
 
 checkType :: TypeExpr -> ISC TypeExpr
-checkType (ConstructorType tc) = checkTypeConstructor tc
-checkType (ApplyType  ty1 ty2) = liftM2 ApplyType (checkType ty1) (checkType ty2)
-checkType (VariableType    tv) = checkType $ ConstructorType (qualify tv)
-checkType (TupleType      tys) = liftM TupleType (mapM checkType tys)
-checkType (ListType        ty) = liftM ListType (checkType ty)
-checkType (ArrowType  ty1 ty2) = liftM2 ArrowType (checkType ty1) (checkType ty2)
-checkType (ParenType       ty) = liftM ParenType (checkType ty)
-checkType (ForallType   vs ty) = liftM (ForallType vs) (checkType ty)
+checkType (ConstructorType spi tc) = checkTypeConstructor spi tc
+checkType (ApplyType  spi ty1 ty2) =
+  liftM2 (ApplyType spi) (checkType ty1) (checkType ty2)
+checkType (VariableType    spi tv) =
+  checkType $ ConstructorType spi (qualify tv)
+checkType (TupleType      spi tys) = liftM (TupleType spi) (mapM checkType tys)
+checkType (ListType        spi ty) = liftM (ListType spi) (checkType ty)
+checkType (ArrowType  spi ty1 ty2) =
+  liftM2 (ArrowType spi) (checkType ty1) (checkType ty2)
+checkType (ParenType      spi  ty) = liftM (ParenType spi) (checkType ty)
+checkType (ForallType   spi vs ty) = liftM (ForallType spi vs) (checkType ty)
 
 checkClosed :: [Ident] -> TypeExpr -> ISC ()
-checkClosed _   (ConstructorType _) = return ()
-checkClosed tvs (ApplyType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
-checkClosed tvs (VariableType   tv) =
+checkClosed _   (ConstructorType _ _) = return ()
+checkClosed tvs (ApplyType _ ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
+checkClosed tvs (VariableType   _ tv) =
   when (isAnonId tv || tv `notElem` tvs) $ report $ errUnboundVariable tv
-checkClosed tvs (TupleType     tys) = mapM_ (checkClosed tvs) tys
-checkClosed tvs (ListType       ty) = checkClosed tvs ty
-checkClosed tvs (ArrowType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
-checkClosed tvs (ParenType      ty) = checkClosed tvs ty
-checkClosed tvs (ForallType  vs ty) = checkClosed (tvs ++ vs) ty
+checkClosed tvs (TupleType     _ tys) = mapM_ (checkClosed tvs) tys
+checkClosed tvs (ListType       _ ty) = checkClosed tvs ty
+checkClosed tvs (ArrowType _ ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
+checkClosed tvs (ParenType      _ ty) = checkClosed tvs ty
+checkClosed tvs (ForallType  _ vs ty) = checkClosed (tvs ++ vs) ty
 
-checkTypeConstructor :: QualIdent -> ISC TypeExpr
-checkTypeConstructor tc = do
+checkTypeConstructor :: SpanInfo -> QualIdent -> ISC TypeExpr
+checkTypeConstructor spi tc = do
   tyEnv <- getTypeEnv
   case qualLookupTypeKind tc tyEnv of
-    [] | not (isQualified tc) -> return $ VariableType $ unqualify tc
+    [] | not (isQualified tc) -> return $ VariableType spi $ unqualify tc
        | otherwise            -> do
           report $ errUndefinedType tc
-          return $ ConstructorType tc
-    [Data _ _] -> return $ ConstructorType tc
+          return $ ConstructorType spi tc
+    [Data _ _] -> return $ ConstructorType spi tc
     [Alias  _] -> do
                   report $ errBadTypeSynonym tc
-                  return $ ConstructorType tc
+                  return $ ConstructorType spi tc
     _          ->
       internalError "Checks.InterfaceSyntaxCheck.checkTypeConstructor"
 
@@ -280,14 +284,14 @@
 -- ---------------------------------------------------------------------------
 
 typeVars :: TypeExpr -> [Ident]
-typeVars (ConstructorType       _) = []
-typeVars (ApplyType       ty1 ty2) = typeVars ty1 ++ typeVars ty2
-typeVars (VariableType         tv) = [tv]
-typeVars (TupleType           tys) = concatMap typeVars tys
-typeVars (ListType             ty) = typeVars ty
-typeVars (ArrowType       ty1 ty2) = typeVars ty1 ++ typeVars ty2
-typeVars (ParenType            ty) = typeVars ty
-typeVars (ForallType        vs ty) = vs ++ typeVars ty
+typeVars (ConstructorType      _ _) = []
+typeVars (ApplyType      _ ty1 ty2) = typeVars ty1 ++ typeVars ty2
+typeVars (VariableType        _ tv) = [tv]
+typeVars (TupleType          _ tys) = concatMap typeVars tys
+typeVars (ListType            _ ty) = typeVars ty
+typeVars (ArrowType      _ ty1 ty2) = typeVars ty1 ++ typeVars ty2
+typeVars (ParenType           _ ty) = typeVars ty
+typeVars (ForallType       _ vs ty) = vs ++ typeVars ty
 
 isTypeSyn :: QualIdent -> TypeEnv -> Bool
 isTypeSyn tc tEnv = case qualLookupTypeKind tc tEnv of
@@ -341,7 +345,7 @@
   [ "Hidden", what, escName x, "is not defined for", for, qualName tc ]
 
 errIllegalSimpleConstraint :: Constraint -> Message
-errIllegalSimpleConstraint c@(Constraint qcls _) = posMessage qcls $ vcat
+errIllegalSimpleConstraint c@(Constraint _ qcls _) = posMessage qcls $ vcat
   [ text "Illegal class constraint" <+> ppConstraint c
   , text "Constraints in class and instance declarations must be of"
   , text "the form C u, where C is a type class and u is a type variable."
diff --git a/src/Checks/KindCheck.hs b/src/Checks/KindCheck.hs
--- a/src/Checks/KindCheck.hs
+++ b/src/Checks/KindCheck.hs
@@ -16,6 +16,10 @@
 {-# LANGUAGE CPP #-}
 module Checks.KindCheck (kindCheck) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative      ((<$>), (<*>))
 #endif
@@ -26,6 +30,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo ()
 import Curry.Base.Pretty
 import Curry.Syntax
 import Curry.Syntax.Pretty
@@ -53,7 +58,7 @@
 -- synonyms into the type constructor environment.
 
 kindCheck :: TCEnv -> ClassEnv -> Module a -> ((TCEnv, ClassEnv), [Message])
-kindCheck tcEnv clsEnv (Module _ m _ _ ds) = runKCM check initState
+kindCheck tcEnv clsEnv (Module _ _ m _ _ ds) = runKCM check initState
   where
     check = do
       checkNonRecursiveTypes tds &&> checkAcyclicSuperClasses cds
@@ -84,7 +89,7 @@
 (&&>) :: KCM () -> KCM () -> KCM ()
 pre &&> suf = do
   errs <- pre >> S.gets errors
-  if null errs then suf else return ()
+  when (null errs) suf
 
 runKCM :: KCM a -> KCState -> (a, [Message])
 runKCM kcm s = let (a, s') = S.runState kcm s in (a, reverse $ errors s')
@@ -162,61 +167,61 @@
   fts m (NewRecordDecl _ _ (_, ty)) = fts m ty
 
 instance HasType Constraint where
-  fts m (Constraint qcls _) = fts m qcls
+  fts m (Constraint _ qcls _) = fts m qcls
 
 instance HasType QualTypeExpr where
-  fts m (QualTypeExpr cx ty) = fts m cx . fts m ty
+  fts m (QualTypeExpr _ cx ty) = fts m cx . fts m ty
 
 instance HasType TypeExpr where
-  fts m (ConstructorType      tc) = fts m tc
-  fts m (ApplyType       ty1 ty2) = fts m ty1 . fts m ty2
-  fts _ (VariableType          _) = id
-  fts m (TupleType           tys) = (tupleId (length tys) :) . fts m tys
-  fts m (ListType             ty) = (listId :) . fts m ty
-  fts m (ArrowType       ty1 ty2) = (arrowId :) . fts m ty1 . fts m ty2
-  fts m (ParenType            ty) = fts m ty
-  fts m (ForallType         _ ty) = fts m ty
+  fts m (ConstructorType     _ tc) = fts m tc
+  fts m (ApplyType      _ ty1 ty2) = fts m ty1 . fts m ty2
+  fts _ (VariableType         _ _) = id
+  fts m (TupleType          _ tys) = (tupleId (length tys) :) . fts m tys
+  fts m (ListType            _ ty) = (listId :) . fts m ty
+  fts m (ArrowType      _ ty1 ty2) = (arrowId :) . fts m ty1 . fts m ty2
+  fts m (ParenType           _ ty) = fts m ty
+  fts m (ForallType        _ _ ty) = fts m ty
 
 instance HasType (Equation a) where
   fts m (Equation _ _ rhs) = fts m rhs
 
 instance HasType (Rhs a) where
-  fts m (SimpleRhs  _ e ds) = fts m e . fts m ds
-  fts m (GuardedRhs  es ds) = fts m es . fts m ds
+  fts m (SimpleRhs  _ e  ds) = fts m e . fts m ds
+  fts m (GuardedRhs _ es ds) = fts m es . fts m ds
 
 instance HasType (CondExpr a) where
   fts m (CondExpr _ g e) = fts m g . fts m e
 
 instance HasType (Expression a) where
-  fts _ (Literal             _ _) = id
-  fts _ (Variable            _ _) = id
-  fts _ (Constructor         _ _) = id
-  fts m (Paren                 e) = fts m e
-  fts m (Typed              e ty) = fts m e . fts m ty
-  fts m (Record           _ _ fs) = fts m fs
-  fts m (RecordUpdate       e fs) = fts m e . fts m fs
-  fts m (Tuple                es) = fts m es
-  fts m (List               _ es) = fts m es
-  fts m (ListCompr        e stms) = fts m e . fts m stms
-  fts m (EnumFrom              e) = fts m e
-  fts m (EnumFromThen      e1 e2) = fts m e1 . fts m e2
-  fts m (EnumFromTo        e1 e2) = fts m e1 . fts m e2
-  fts m (EnumFromThenTo e1 e2 e3) = fts m e1 . fts m e2 . fts m e3
-  fts m (UnaryMinus            e) = fts m e
-  fts m (Apply             e1 e2) = fts m e1 . fts m e2
-  fts m (InfixApply      e1 _ e2) = fts m e1 . fts m e2
-  fts m (LeftSection         e _) = fts m e
-  fts m (RightSection        _ e) = fts m e
-  fts m (Lambda              _ e) = fts m e
-  fts m (Let                ds e) = fts m ds . fts m e
-  fts m (Do               stms e) = fts m stms . fts m e
-  fts m (IfThenElse     e1 e2 e3) = fts m e1 . fts m e2 . fts m e3
-  fts m (Case             _ e as) = fts m e . fts m as
+  fts _ (Literal             _ _ _) = id
+  fts _ (Variable            _ _ _) = id
+  fts _ (Constructor         _ _ _) = id
+  fts m (Paren                 _ e) = fts m e
+  fts m (Typed              _ e ty) = fts m e . fts m ty
+  fts m (Record           _ _ _ fs) = fts m fs
+  fts m (RecordUpdate       _ e fs) = fts m e . fts m fs
+  fts m (Tuple                _ es) = fts m es
+  fts m (List               _ _ es) = fts m es
+  fts m (ListCompr        _ e stms) = fts m e . fts m stms
+  fts m (EnumFrom              _ e) = fts m e
+  fts m (EnumFromThen      _ e1 e2) = fts m e1 . fts m e2
+  fts m (EnumFromTo        _ e1 e2) = fts m e1 . fts m e2
+  fts m (EnumFromThenTo _ e1 e2 e3) = fts m e1 . fts m e2 . fts m e3
+  fts m (UnaryMinus            _ e) = fts m e
+  fts m (Apply             _ e1 e2) = fts m e1 . fts m e2
+  fts m (InfixApply      _ e1 _ e2) = fts m e1 . fts m e2
+  fts m (LeftSection         _ e _) = fts m e
+  fts m (RightSection        _ _ e) = fts m e
+  fts m (Lambda              _ _ e) = fts m e
+  fts m (Let                _ ds e) = fts m ds . fts m e
+  fts m (Do               _ stms e) = fts m stms . fts m e
+  fts m (IfThenElse     _ e1 e2 e3) = fts m e1 . fts m e2 . fts m e3
+  fts m (Case             _ _ e as) = fts m e . fts m as
 
 instance HasType (Statement a) where
-  fts m (StmtExpr   e) = fts m e
-  fts m (StmtDecl  ds) = fts m ds
-  fts m (StmtBind _ e) = fts m e
+  fts m (StmtExpr _   e) = fts m e
+  fts m (StmtDecl _  ds) = fts m ds
+  fts m (StmtBind _ _ e) = fts m e
 
 instance HasType (Alt a) where
   fts m (Alt _ _ rhs) = fts m rhs
@@ -267,7 +272,7 @@
 fc :: ModuleIdent -> Context -> [Ident]
 fc m = foldr fc' []
   where
-    fc' (Constraint qcls _) = maybe id (:) (localIdent m qcls)
+    fc' (Constraint _ qcls _) = maybe id (:) (localIdent m qcls)
 
 checkAcyclicSuperClasses :: [Decl a] -> KCM ()
 checkAcyclicSuperClasses ds = do
@@ -306,7 +311,7 @@
 -- from the 'MonadFix' type class.
 
 bindKind :: ModuleIdent -> TCEnv -> ClassEnv -> TCEnv -> Decl a -> KCM TCEnv
-bindKind m tcEnv' clsEnv tcEnv (DataDecl _ tc tvs cs _) = do
+bindKind m tcEnv' clsEnv tcEnv (DataDecl _ tc tvs cs _) =
   bindTypeConstructor DataType tc tvs (Just KindStar) (map mkData cs) tcEnv
   where
     mkData (ConstrDecl _ evs cx     c  tys) = mkData' evs cx c  tys
@@ -325,7 +330,7 @@
             tvs' = tvs ++ evs
             PredType ps ty = expandConstrType m tcEnv' clsEnv qtc tvs' cx tys
             tys' = arrowArgs ty
-bindKind _ _     _       tcEnv (ExternalDataDecl _ tc tvs) = do
+bindKind _ _     _       tcEnv (ExternalDataDecl _ tc tvs) =
   bindTypeConstructor DataType tc tvs (Just KindStar) [] tcEnv
 bindKind m tcEnv' _      tcEnv (NewtypeDecl _ tc tvs nc _) =
   bindTypeConstructor RenamingType tc tvs (Just KindStar) (mkData nc) tcEnv
@@ -392,7 +397,7 @@
   where qcls = qualifyWith m cls
         ms = map (\f -> (f, f `elem` fs)) $ concatMap methods ds
         fs = concatMap impls ds
-        sclss = nub $ map (\(Constraint cls' _) -> getOrigName m cls' tcEnv) cx
+        sclss = nub $ map (\(Constraint _ cls' _) -> getOrigName m cls' tcEnv) cx
 bindClass _ _ clsEnv _ = clsEnv
 
 instantiateWithDefaultKind :: TypeInfo -> TypeInfo
@@ -503,88 +508,88 @@
 kcRhs tcEnv (SimpleRhs p e ds) = do
   kcExpr tcEnv p e
   mapM_ (kcDecl tcEnv) ds
-kcRhs tcEnv (GuardedRhs es ds) = do
+kcRhs tcEnv (GuardedRhs _ es ds) = do
   mapM_ (kcCondExpr tcEnv) es
   mapM_ (kcDecl tcEnv) ds
 
 kcCondExpr :: TCEnv -> CondExpr a -> KCM ()
 kcCondExpr tcEnv (CondExpr p g e) = kcExpr tcEnv p g >> kcExpr tcEnv p e
 
-kcExpr :: TCEnv -> Position -> Expression a -> KCM ()
-kcExpr _     _ (Literal _ _) = ok
-kcExpr _     _ (Variable _ _) = ok
-kcExpr _     _ (Constructor _ _) = ok
-kcExpr tcEnv p (Paren e) = kcExpr tcEnv p e
-kcExpr tcEnv p (Typed e qty) = do
+kcExpr :: HasPosition p => TCEnv -> p -> Expression a -> KCM ()
+kcExpr _     _ (Literal _ _ _) = ok
+kcExpr _     _ (Variable _ _ _) = ok
+kcExpr _     _ (Constructor _ _ _) = ok
+kcExpr tcEnv p (Paren _ e) = kcExpr tcEnv p e
+kcExpr tcEnv p (Typed _ e qty) = do
   kcExpr tcEnv p e
   kcTypeSig tcEnv p qty
-kcExpr tcEnv p (Record _ _ fs) = mapM_ (kcField tcEnv p) fs
-kcExpr tcEnv p (RecordUpdate e fs) = do
+kcExpr tcEnv p (Record _ _ _ fs) = mapM_ (kcField tcEnv p) fs
+kcExpr tcEnv p (RecordUpdate _ e fs) = do
   kcExpr tcEnv p e
   mapM_ (kcField tcEnv p) fs
-kcExpr tcEnv p (Tuple es) = mapM_ (kcExpr tcEnv p) es
-kcExpr tcEnv p (List _ es) = mapM_ (kcExpr tcEnv p) es
-kcExpr tcEnv p (ListCompr e stms) = do
+kcExpr tcEnv p (Tuple _ es) = mapM_ (kcExpr tcEnv p) es
+kcExpr tcEnv p (List _ _ es) = mapM_ (kcExpr tcEnv p) es
+kcExpr tcEnv p (ListCompr _ e stms) = do
   kcExpr tcEnv p e
   mapM_ (kcStmt tcEnv p) stms
-kcExpr tcEnv p (EnumFrom e) = kcExpr tcEnv p e
-kcExpr tcEnv p (EnumFromThen e1 e2) = do
+kcExpr tcEnv p (EnumFrom _ e) = kcExpr tcEnv p e
+kcExpr tcEnv p (EnumFromThen _ e1 e2) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
-kcExpr tcEnv p (EnumFromTo e1 e2) = do
+kcExpr tcEnv p (EnumFromTo _ e1 e2) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
-kcExpr tcEnv p (EnumFromThenTo e1 e2 e3) = do
+kcExpr tcEnv p (EnumFromThenTo _ e1 e2 e3) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
   kcExpr tcEnv p e3
-kcExpr tcEnv p (UnaryMinus e) = kcExpr tcEnv p e
-kcExpr tcEnv p (Apply e1 e2) = do
+kcExpr tcEnv p (UnaryMinus _ e) = kcExpr tcEnv p e
+kcExpr tcEnv p (Apply _ e1 e2) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
-kcExpr tcEnv p (InfixApply e1 _ e2) = do
+kcExpr tcEnv p (InfixApply _ e1 _ e2) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
-kcExpr tcEnv p (LeftSection e _) = kcExpr tcEnv p e
-kcExpr tcEnv p (RightSection _ e) = kcExpr tcEnv p e
-kcExpr tcEnv p (Lambda _ e) = kcExpr tcEnv p e
-kcExpr tcEnv p (Let ds e) = do
+kcExpr tcEnv p (LeftSection _ e _) = kcExpr tcEnv p e
+kcExpr tcEnv p (RightSection _ _ e) = kcExpr tcEnv p e
+kcExpr tcEnv p (Lambda _ _ e) = kcExpr tcEnv p e
+kcExpr tcEnv p (Let _ ds e) = do
   mapM_ (kcDecl tcEnv) ds
   kcExpr tcEnv p e
-kcExpr tcEnv p (Do stms e) = do
+kcExpr tcEnv p (Do _ stms e) = do
   mapM_ (kcStmt tcEnv p) stms
   kcExpr tcEnv p e
-kcExpr tcEnv p (IfThenElse e1 e2 e3) = do
+kcExpr tcEnv p (IfThenElse _ e1 e2 e3) = do
   kcExpr tcEnv p e1
   kcExpr tcEnv p e2
   kcExpr tcEnv p e3
-kcExpr tcEnv p (Case _ e alts) = do
+kcExpr tcEnv p (Case _ _ e alts) = do
   kcExpr tcEnv p e
   mapM_ (kcAlt tcEnv) alts
 
-kcStmt :: TCEnv -> Position -> Statement a -> KCM ()
-kcStmt tcEnv p (StmtExpr e) = kcExpr tcEnv p e
-kcStmt tcEnv _ (StmtDecl ds) = mapM_ (kcDecl tcEnv) ds
-kcStmt tcEnv p (StmtBind _ e) = kcExpr tcEnv p e
+kcStmt :: HasPosition p => TCEnv -> p -> Statement a -> KCM ()
+kcStmt tcEnv p (StmtExpr _ e) = kcExpr tcEnv p e
+kcStmt tcEnv _ (StmtDecl _ ds) = mapM_ (kcDecl tcEnv) ds
+kcStmt tcEnv p (StmtBind _ _ e) = kcExpr tcEnv p e
 
 kcAlt :: TCEnv -> Alt a -> KCM ()
 kcAlt tcEnv (Alt _ _ rhs) = kcRhs tcEnv rhs
 
-kcField :: TCEnv -> Position -> Field (Expression a) -> KCM ()
+kcField :: HasPosition p => TCEnv -> p -> Field (Expression a) -> KCM ()
 kcField tcEnv p (Field _ _ e) = kcExpr tcEnv p e
 
-kcContext :: TCEnv -> Position -> Context -> KCM ()
+kcContext :: HasPosition p => TCEnv -> p -> Context -> KCM ()
 kcContext tcEnv p = mapM_ (kcConstraint tcEnv p)
 
-kcConstraint :: TCEnv -> Position -> Constraint -> KCM ()
-kcConstraint tcEnv p sc@(Constraint qcls ty) = do
+kcConstraint :: HasPosition p => TCEnv -> p -> Constraint -> KCM ()
+kcConstraint tcEnv p sc@(Constraint _ qcls ty) = do
   m <- getModuleIdent
   kcType tcEnv p "class constraint" doc (clsKind m qcls tcEnv) ty
   where
     doc = ppConstraint sc
 
-kcTypeSig :: TCEnv -> Position -> QualTypeExpr -> KCM ()
-kcTypeSig tcEnv p (QualTypeExpr cx ty) = do
+kcTypeSig :: HasPosition p => TCEnv -> p -> QualTypeExpr -> KCM ()
+kcTypeSig tcEnv p (QualTypeExpr _ cx ty) = do
   tcEnv' <- foldM bindFreshKind tcEnv free
   kcContext tcEnv' p cx
   kcValueType tcEnv' p "type signature" doc ty
@@ -592,18 +597,18 @@
     free = filter (null . flip lookupTypeInfo tcEnv) $ nub $ fv ty
     doc = ppTypeExpr 0 ty
 
-kcValueType :: TCEnv -> Position -> String -> Doc -> TypeExpr -> KCM ()
+kcValueType :: HasPosition p => TCEnv -> p -> String -> Doc -> TypeExpr -> KCM ()
 kcValueType tcEnv p what doc = kcType tcEnv p what doc KindStar
 
-kcType :: TCEnv -> Position -> String -> Doc -> Kind -> TypeExpr -> KCM ()
+kcType :: HasPosition p => TCEnv -> p -> String -> Doc -> Kind -> TypeExpr -> KCM ()
 kcType tcEnv p what doc k ty = do
   k' <- kcTypeExpr tcEnv p "type expression" doc' 0 ty
   unify p what (doc $-$ text "Type:" <+> doc') k k'
   where
     doc' = ppTypeExpr 0 ty
 
-kcTypeExpr :: TCEnv -> Position -> String -> Doc -> Int -> TypeExpr -> KCM Kind
-kcTypeExpr tcEnv p _ _ n (ConstructorType tc) = do
+kcTypeExpr :: HasPosition p => TCEnv -> p -> String -> Doc -> Int -> TypeExpr -> KCM Kind
+kcTypeExpr tcEnv p _ _ n (ConstructorType _ tc) = do
   m <- getModuleIdent
   case qualLookupTypeInfo tc tcEnv of
     [AliasType _ _ n' _] -> case n >= n' of
@@ -612,29 +617,29 @@
         report $ errPartialAlias p tc n' n
         freshKindVar
     _ -> return $ tcKind m tc tcEnv
-kcTypeExpr tcEnv p what doc n (ApplyType ty1 ty2) = do
+kcTypeExpr tcEnv p what doc n (ApplyType _ ty1 ty2) = do
   (alpha, beta) <- kcTypeExpr tcEnv p what doc (n + 1) ty1 >>=
     kcArrow p what (doc $-$ text "Type:" <+> ppTypeExpr 0 ty1)
   kcTypeExpr tcEnv p what doc 0 ty2 >>=
     unify p what (doc $-$ text "Type:" <+> ppTypeExpr 0 ty2) alpha
   return beta
-kcTypeExpr tcEnv _ _ _ _ (VariableType tv) = return (varKind tv tcEnv)
-kcTypeExpr tcEnv p what doc _ (TupleType tys) = do
+kcTypeExpr tcEnv _ _ _ _ (VariableType _ tv) = return (varKind tv tcEnv)
+kcTypeExpr tcEnv p what doc _ (TupleType _ tys) = do
   mapM_ (kcValueType tcEnv p what doc) tys
   return KindStar
-kcTypeExpr tcEnv p what doc _ (ListType ty) = do
+kcTypeExpr tcEnv p what doc _ (ListType _ ty) = do
   kcValueType tcEnv p what doc ty
   return KindStar
-kcTypeExpr tcEnv p what doc _ (ArrowType ty1 ty2) = do
+kcTypeExpr tcEnv p what doc _ (ArrowType _ ty1 ty2) = do
   kcValueType tcEnv p what doc ty1
   kcValueType tcEnv p what doc ty2
   return KindStar
-kcTypeExpr tcEnv p what doc n (ParenType ty) = kcTypeExpr tcEnv p what doc n ty
-kcTypeExpr tcEnv p what doc n (ForallType vs ty) = do
-  tcEnv' <- foldM bindFreshKind tcEnv $ vs
+kcTypeExpr tcEnv p what doc n (ParenType _ ty) = kcTypeExpr tcEnv p what doc n ty
+kcTypeExpr tcEnv p what doc n (ForallType _ vs ty) = do
+  tcEnv' <- foldM bindFreshKind tcEnv vs
   kcTypeExpr tcEnv' p what doc n ty
 
-kcArrow :: Position -> String -> Doc -> Kind -> KCM (Kind, Kind)
+kcArrow :: HasPosition p => p -> String -> Doc -> Kind -> KCM (Kind, Kind)
 kcArrow p what doc k = do
   theta <- getKindSubst
   case subst theta k of
@@ -653,7 +658,7 @@
 -- ---------------------------------------------------------------------------
 
 -- The unification uses Robinson's algorithm.
-unify :: Position -> String -> Doc -> Kind -> Kind -> KCM ()
+unify :: HasPosition p => p -> String -> Doc -> Kind -> Kind -> KCM ()
 unify p what doc k1 k2 = do
   theta <- getKindSubst
   let k1' = subst theta k1
@@ -723,7 +728,7 @@
     types del [tc']      = del <> space <> text "and" <+> typePos tc'
     types _   (tc':tcs') = comma <+> typePos tc' <> types comma tcs'
     typePos tc' =
-      text (idName tc') <+> parens (text $ showLine $ idPosition tc')
+      text (idName tc') <+> parens (text $ showLine $ getPosition tc')
 
 errRecursiveClasses :: [Ident] -> Message
 errRecursiveClasses []         = internalError
@@ -738,16 +743,16 @@
     classes del [cls']       = del <> space <> text "and" <+> classPos cls'
     classes _   (cls':clss') = comma <+> classPos cls' <> classes comma clss'
     classPos cls' =
-      text (idName cls') <+> parens (text $ showLine $ idPosition cls')
+      text (idName cls') <+> parens (text $ showLine $ getPosition cls')
 
-errNonArrowKind :: Position -> String -> Doc -> Kind -> Message
+errNonArrowKind :: HasPosition p => p -> String -> Doc -> Kind -> Message
 errNonArrowKind p what doc k = posMessage p $ vcat
   [ text "Kind error in" <+> text what, doc
   , text "Kind:" <+> ppKind k
   , text "Cannot be applied"
   ]
 
-errPartialAlias :: Position -> QualIdent -> Int -> Int -> Message
+errPartialAlias :: HasPosition p => p -> QualIdent -> Int -> Int -> Message
 errPartialAlias p tc arity argc = posMessage p $ hsep
   [ text "Type synonym", ppQIdent tc
   , text "requires at least"
@@ -757,7 +762,7 @@
   where
     plural n x = if n == 1 then x else x ++ "s"
 
-errKindMismatch :: Position -> String -> Doc -> Kind -> Kind -> Message
+errKindMismatch ::  HasPosition p => p -> String -> Doc -> Kind -> Kind -> Message
 errKindMismatch p what doc k1 k2 = posMessage p $ vcat
   [ text "Kind error in"  <+> text what, doc
   , text "Inferred kind:" <+> ppKind k2
diff --git a/src/Checks/PrecCheck.hs b/src/Checks/PrecCheck.hs
--- a/src/Checks/PrecCheck.hs
+++ b/src/Checks/PrecCheck.hs
@@ -31,6 +31,8 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
+import Curry.Base.Span
 import Curry.Base.Pretty
 import Curry.Syntax
 
@@ -145,95 +147,99 @@
   Equation p <$> checkLhs lhs <*> checkRhs rhs
 
 checkLhs :: Lhs a -> PCM (Lhs a)
-checkLhs (FunLhs    f ts) = FunLhs f <$> mapM checkPattern ts
-checkLhs (OpLhs t1 op t2) =
-  flip OpLhs op <$> (checkPattern t1 >>= checkOpL op)
-                <*> (checkPattern t2 >>= checkOpR op)
-checkLhs (ApLhs   lhs ts) =
-  ApLhs <$> checkLhs lhs <*> mapM checkPattern ts
+checkLhs (FunLhs spi     f ts) = FunLhs spi f <$> mapM checkPattern ts
+checkLhs (OpLhs  spi t1 op t2) =
+  flip (OpLhs spi) op <$> (checkPattern t1 >>= checkOpL op)
+                      <*> (checkPattern t2 >>= checkOpR op)
+checkLhs (ApLhs  spi   lhs ts) =
+  ApLhs spi <$> checkLhs lhs <*> mapM checkPattern ts
 
 checkPattern :: Pattern a -> PCM (Pattern a)
-checkPattern l@(LiteralPattern        _ _) = return l
-checkPattern n@(NegativePattern       _ _) = return n
-checkPattern v@(VariablePattern       _ _) = return v
-checkPattern (ConstructorPattern   a c ts) =
-  ConstructorPattern a c <$> mapM checkPattern ts
-checkPattern (InfixPattern     a t1 op t2) = do
+checkPattern l@(LiteralPattern        _ _ _) = return l
+checkPattern n@(NegativePattern       _ _ _) = return n
+checkPattern v@(VariablePattern       _ _ _) = return v
+checkPattern (ConstructorPattern spi a c ts) =
+  ConstructorPattern spi a c <$> mapM checkPattern ts
+checkPattern (InfixPattern   _ a t1 op t2) = do
   t1' <- checkPattern t1
   t2' <- checkPattern t2
-  fixPrecT (InfixPattern a) t1' op t2'
-checkPattern (ParenPattern              t) =
-  ParenPattern <$> checkPattern t
-checkPattern (TuplePattern             ts) =
-  TuplePattern <$> mapM checkPattern ts
-checkPattern (ListPattern            a ts) =
-  ListPattern a <$> mapM checkPattern ts
-checkPattern (AsPattern               v t) =
-  AsPattern v <$> checkPattern t
-checkPattern (LazyPattern               t) =
-  LazyPattern <$> checkPattern t
-checkPattern (FunctionPattern      a f ts) =
-  FunctionPattern a f <$> mapM checkPattern ts
-checkPattern (InfixFuncPattern a t1 op t2) = do
+  fixPrecT mkInfixPattern t1' op t2'
+  where mkInfixPattern t1'' op'' t2'' =
+          InfixPattern (t1'' @+@ t2'') a t1'' op'' t2''
+checkPattern (ParenPattern              spi t) =
+  ParenPattern spi <$> checkPattern t
+checkPattern (TuplePattern             spi ts) =
+  TuplePattern spi <$> mapM checkPattern ts
+checkPattern (ListPattern            spi a ts) =
+  ListPattern spi a <$> mapM checkPattern ts
+checkPattern (AsPattern               spi v t) =
+  AsPattern spi v <$> checkPattern t
+checkPattern (LazyPattern               spi t) =
+  LazyPattern spi <$> checkPattern t
+checkPattern (FunctionPattern      spi a f ts) =
+  FunctionPattern spi a f <$> mapM checkPattern ts
+checkPattern (InfixFuncPattern _ a t1 op t2) = do
   t1' <- checkPattern t1
   t2' <- checkPattern t2
-  fixPrecT (InfixFuncPattern a) t1' op t2'
-checkPattern (RecordPattern       a c fs) =
-  RecordPattern a c <$> mapM (checkField checkPattern) fs
+  fixPrecT mkInfixFuncPattern t1' op t2'
+  where mkInfixFuncPattern t1'' op'' t2'' =
+          InfixFuncPattern (t1'' @+@ t2'') a t1'' op'' t2''
+checkPattern (RecordPattern       spi a c fs) =
+  RecordPattern spi a c <$> mapM (checkField checkPattern) fs
 
 checkRhs :: Rhs a -> PCM (Rhs a)
-checkRhs (SimpleRhs p e ds) = withLocalPrecEnv $
-  flip (SimpleRhs p) <$> checkDecls ds <*> checkExpr e
-checkRhs (GuardedRhs es ds) = withLocalPrecEnv $
-  (flip GuardedRhs) <$> checkDecls ds <*> mapM checkCondExpr es
+checkRhs (SimpleRhs  spi e  ds) = withLocalPrecEnv $
+  flip (SimpleRhs spi) <$> checkDecls ds <*> checkExpr e
+checkRhs (GuardedRhs spi es ds) = withLocalPrecEnv $
+  flip (GuardedRhs spi) <$> checkDecls ds <*> mapM checkCondExpr es
 
 checkCondExpr :: CondExpr a -> PCM (CondExpr a)
 checkCondExpr (CondExpr p g e) = CondExpr p <$> checkExpr g <*> checkExpr e
 
 checkExpr :: Expression a -> PCM (Expression a)
-checkExpr l@(Literal       _ _) = return l
-checkExpr v@(Variable      _ _) = return v
-checkExpr c@(Constructor   _ _) = return c
-checkExpr (Paren             e) = Paren <$> checkExpr e
-checkExpr (Typed          e ty) = flip Typed ty <$> checkExpr e
-checkExpr (Record       a c fs) = Record a c <$> mapM (checkField checkExpr) fs
-checkExpr (RecordUpdate   e fs) = RecordUpdate <$> (checkExpr e)
-                                             <*> mapM (checkField checkExpr) fs
-checkExpr (Tuple            es) = Tuple <$> mapM checkExpr es
-checkExpr (List           a es) = List a <$> mapM checkExpr es
-checkExpr (ListCompr      e qs) = withLocalPrecEnv $
-  flip ListCompr <$> mapM checkStmt qs <*> checkExpr e
-checkExpr (EnumFrom              e) = EnumFrom <$> checkExpr e
-checkExpr (EnumFromThen      e1 e2) =
-  EnumFromThen <$> checkExpr e1 <*> checkExpr e2
-checkExpr (EnumFromTo        e1 e2) =
-  EnumFromTo <$> checkExpr e1 <*> checkExpr e2
-checkExpr (EnumFromThenTo e1 e2 e3) =
-  EnumFromThenTo <$> checkExpr e1 <*> checkExpr e2 <*> checkExpr e3
-checkExpr (UnaryMinus            e) = UnaryMinus <$> checkExpr e
-checkExpr (Apply e1 e2) =
-  Apply <$> checkExpr e1 <*> checkExpr e2
-checkExpr (InfixApply e1 op e2) = do
+checkExpr l@(Literal          _ _ _) = return l
+checkExpr v@(Variable         _ _ _) = return v
+checkExpr c@(Constructor      _ _ _) = return c
+checkExpr (Paren              spi e) = Paren spi <$> checkExpr e
+checkExpr (Typed           spi e ty) = flip (Typed spi) ty <$> checkExpr e
+checkExpr (Record        spi a c fs) = Record spi a c <$> mapM (checkField checkExpr) fs
+checkExpr (RecordUpdate    spi e fs) = RecordUpdate spi <$> checkExpr e
+                                                       <*> mapM (checkField checkExpr) fs
+checkExpr (Tuple            spi es) = Tuple spi <$> mapM checkExpr es
+checkExpr (List           spi a es) = List spi a <$> mapM checkExpr es
+checkExpr (ListCompr      spi e qs) = withLocalPrecEnv $
+  flip (ListCompr spi) <$> mapM checkStmt qs <*> checkExpr e
+checkExpr (EnumFrom              spi e) = EnumFrom spi <$> checkExpr e
+checkExpr (EnumFromThen      spi e1 e2) =
+  EnumFromThen spi <$> checkExpr e1 <*> checkExpr e2
+checkExpr (EnumFromTo        spi e1 e2) =
+  EnumFromTo spi <$> checkExpr e1 <*> checkExpr e2
+checkExpr (EnumFromThenTo spi e1 e2 e3) =
+  EnumFromThenTo spi <$> checkExpr e1 <*> checkExpr e2 <*> checkExpr e3
+checkExpr (UnaryMinus            spi e) = UnaryMinus spi <$> checkExpr e
+checkExpr (Apply spi e1 e2) =
+  Apply spi <$> checkExpr e1 <*> checkExpr e2
+checkExpr (InfixApply spi e1 op e2) = do
   e1' <- checkExpr e1
   e2' <- checkExpr e2
-  fixPrec e1' op e2'
-checkExpr (LeftSection      e op) = checkExpr e >>= checkLSection op
-checkExpr (RightSection     op e) = checkExpr e >>= checkRSection op
-checkExpr (Lambda           ts e) =
-  Lambda <$> mapM checkPattern ts <*> checkExpr e
-checkExpr (Let              ds e) = withLocalPrecEnv $
-  Let <$> checkDecls ds <*> checkExpr e
-checkExpr (Do              sts e) = withLocalPrecEnv $
-  Do <$>  mapM checkStmt sts <*> checkExpr e
-checkExpr (IfThenElse   e1 e2 e3) =
-  IfThenElse <$> checkExpr e1 <*> checkExpr e2 <*> checkExpr e3
-checkExpr (Case        ct e alts) =
-  Case ct <$> checkExpr e <*> mapM checkAlt alts
+  fixPrec spi e1' op e2'
+checkExpr (LeftSection      spi e op) = checkExpr e >>= checkLSection spi op
+checkExpr (RightSection     spi op e) = checkExpr e >>= checkRSection spi op
+checkExpr (Lambda           spi ts e) =
+  Lambda spi <$> mapM checkPattern ts <*> checkExpr e
+checkExpr (Let              spi ds e) = withLocalPrecEnv $
+  Let spi <$> checkDecls ds <*> checkExpr e
+checkExpr (Do              spi sts e) = withLocalPrecEnv $
+  Do spi <$>  mapM checkStmt sts <*> checkExpr e
+checkExpr (IfThenElse   spi e1 e2 e3) =
+  IfThenElse spi <$> checkExpr e1 <*> checkExpr e2 <*> checkExpr e3
+checkExpr (Case        spi ct e alts) =
+  Case spi ct <$> checkExpr e <*> mapM checkAlt alts
 
 checkStmt :: Statement a -> PCM (Statement a)
-checkStmt (StmtExpr   e) = StmtExpr <$> checkExpr e
-checkStmt (StmtDecl  ds) = StmtDecl <$> checkDecls ds
-checkStmt (StmtBind t e) = StmtBind <$> checkPattern t <*> checkExpr e
+checkStmt (StmtExpr spi   e) = StmtExpr spi <$> checkExpr e
+checkStmt (StmtDecl spi  ds) = StmtDecl spi <$> checkDecls ds
+checkStmt (StmtBind spi t e) = StmtBind spi <$> checkPattern t <*> checkExpr e
 
 checkAlt :: Alt a -> PCM (Alt a)
 checkAlt (Alt p t rhs) = Alt p <$> checkPattern t <*> checkRhs rhs
@@ -259,56 +265,59 @@
 -- Note that both arguments already have been checked before 'fixPrec'
 -- is called.
 
-fixPrec :: Expression a -> InfixOp a -> Expression a -> PCM (Expression a)
-fixPrec (UnaryMinus e1) op e2 = do
+fixPrec :: SpanInfo -> Expression a -> InfixOp a -> Expression a -> PCM (Expression a)
+fixPrec spi (UnaryMinus spi' e1) op e2 = do
   OpPrec fix pr <- getOpPrec op
   if pr < 6 || pr == 6 && fix == InfixL
-    then fixRPrec (UnaryMinus e1) op e2
+    then fixRPrec spi (UnaryMinus spi' e1) op e2
     else if pr > 6
-      then fixUPrec e1 op e2
+      then fixUPrec spi' e1 op e2
       else do
         report $ errAmbiguousParse "unary" (qualify minusId) (opName op)
-        return $ InfixApply (UnaryMinus e1) op e2
-fixPrec e1 op e2 = fixRPrec e1 op e2
+        return $ InfixApply spi (UnaryMinus spi' e1) op e2
+fixPrec spi e1 op e2 = fixRPrec spi e1 op e2
 
-fixUPrec :: Expression a -> InfixOp a -> Expression a
+fixUPrec :: SpanInfo -> Expression a -> InfixOp a -> Expression a
          -> PCM (Expression a)
-fixUPrec e1 op e2@(UnaryMinus _) = do
+fixUPrec spi e1 op e2@(UnaryMinus spi' _) = do
   report $ errAmbiguousParse "operator" (opName op) (qualify minusId)
-  return $ UnaryMinus (InfixApply e1 op e2)
-fixUPrec e1 op1 e'@(InfixApply e2 op2 e3) = do
+  return $ UnaryMinus spi' (InfixApply spi e1 op e2)
+fixUPrec spi e1 op1 e'@(InfixApply spi' e2 op2 e3) = do
   OpPrec fix2 pr2 <- getOpPrec op2
   if pr2 < 6 || pr2 == 6 && fix2 == InfixL
     then do
-      left <- fixUPrec e1 op1 e2
-      return $ InfixApply left op2 e3
+      left <- fixUPrec spi e1 op1 e2
+      return $ InfixApply (left @+@ e3) left op2 e3
     else if pr2 > 6
       then do
-        op <- fixRPrec e1 op1 $ InfixApply e2 op2 e3
-        return $ UnaryMinus op
+        op <- fixRPrec spi e1 op1 $ InfixApply spi' e2 op2 e3
+        return $ updateEndPos $ UnaryMinus spi' op
       else do
         report $ errAmbiguousParse "unary" (qualify minusId) (opName op2)
-        return $ InfixApply (UnaryMinus e1) op1 e'
-fixUPrec e1 op e2 = return $ UnaryMinus (InfixApply e1 op e2)
+        let left = updateEndPos (UnaryMinus spi' e1)
+        return $ InfixApply (left @+@ e') left op1 e'
+fixUPrec spi e1 op e2 = return $ updateEndPos $ UnaryMinus spi
+  (InfixApply (e1 @+@ e2) e1 op e2)
 
-fixRPrec :: Expression a -> InfixOp a -> Expression a -> PCM (Expression a)
-fixRPrec e1 op (UnaryMinus e2) = do
+fixRPrec :: SpanInfo -> Expression a -> InfixOp a -> Expression a
+         -> PCM (Expression a)
+fixRPrec spi e1 op (UnaryMinus spi' e2) = do
   OpPrec _ pr <- getOpPrec op
   unless (pr < 6) $ report $ errAmbiguousParse "operator" (opName op) (qualify minusId)
-  return $ InfixApply e1 op $ UnaryMinus e2
-fixRPrec e1 op1 (InfixApply e2 op2 e3) = do
+  return $ InfixApply spi e1 op $ UnaryMinus spi' e2
+fixRPrec spi e1 op1 (InfixApply spi' e2 op2 e3) = do
   OpPrec fix1 pr1 <- getOpPrec op1
   OpPrec fix2 pr2 <- getOpPrec op2
   if pr1 < pr2 || pr1 == pr2 && fix1 == InfixR && fix2 == InfixR
-     then return $ InfixApply e1 op1 $ InfixApply e2 op2 e3
+     then return $ InfixApply spi e1 op1 $ InfixApply spi' e2 op2 e3
      else if pr1 > pr2 || pr1 == pr2 && fix1 == InfixL && fix2 == InfixL
        then do
-          left <- fixPrec e1 op1 e2
-          return $ InfixApply left op2 e3
+          left <- fixPrec (e1 @+@ e2) e1 op1 e2
+          return $ InfixApply (left @+@ e3) left op2 e3
        else do
          report $ errAmbiguousParse "operator" (opName op1) (opName op2)
-         return $ InfixApply e1 op1 $ InfixApply e2 op2 e3
-fixRPrec e1 op e2 = return $ InfixApply e1 op e2
+         return $ InfixApply spi e1 op1 $ InfixApply spi' e2 op2 e3
+fixRPrec spi e1 op e2 = return $ InfixApply spi e1 op e2
 
 -- The functions 'checkLSection' and 'checkRSection' are used for handling
 -- the precedences inside left and right sections.
@@ -318,32 +327,32 @@
 -- associative for a left section and right associative for a right
 -- section, respectively.
 
-checkLSection :: InfixOp a -> Expression a -> PCM (Expression a)
-checkLSection op e@(UnaryMinus _) = do
+checkLSection :: SpanInfo -> InfixOp a -> Expression a -> PCM (Expression a)
+checkLSection spi op e@(UnaryMinus _ _) = do
   OpPrec fix pr <- getOpPrec op
   unless (pr < 6 || pr == 6 && fix == InfixL) $
     report $ errAmbiguousParse "unary" (qualify minusId) (opName op)
-  return $ LeftSection e op
-checkLSection op1 e@(InfixApply _ op2 _) = do
+  return $ LeftSection spi e op
+checkLSection spi op1 e@(InfixApply _ _ op2 _) = do
   OpPrec fix1 pr1 <- getOpPrec op1
   OpPrec fix2 pr2 <- getOpPrec op2
   unless (pr1 < pr2 || pr1 == pr2 && fix1 == InfixL && fix2 == InfixL) $
     report $ errAmbiguousParse "operator" (opName op1) (opName op2)
-  return $ LeftSection e op1
-checkLSection op e = return $ LeftSection e op
+  return $ LeftSection spi e op1
+checkLSection spi op e = return $ LeftSection spi e op
 
-checkRSection :: InfixOp a -> Expression a -> PCM (Expression a)
-checkRSection op e@(UnaryMinus _) = do
+checkRSection :: SpanInfo -> InfixOp a -> Expression a -> PCM (Expression a)
+checkRSection spi op e@(UnaryMinus _ _) = do
   OpPrec _ pr <- getOpPrec op
   unless (pr < 6) $ report $ errAmbiguousParse "unary" (qualify minusId) (opName op)
-  return $ RightSection op e
-checkRSection op1 e@(InfixApply _ op2 _) = do
+  return $ RightSection spi op e
+checkRSection spi op1 e@(InfixApply _ _ op2 _) = do
   OpPrec fix1 pr1 <- getOpPrec op1
   OpPrec fix2 pr2 <- getOpPrec op2
   unless (pr1 < pr2 || pr1 == pr2 && fix1 == InfixR && fix2 == InfixR) $
     report $ errAmbiguousParse "operator" (opName op1) (opName op2)
-  return $ RightSection op1 e
-checkRSection op e = return $ RightSection op e
+  return $ RightSection spi op1 e
+checkRSection spi op e = return $ RightSection spi op e
 
 -- The functions 'fixPrecT' and 'fixRPrecT' check the relative precedences
 -- of adjacent infix operators in patterns. The patterns will be reordered
@@ -357,7 +366,7 @@
 
 fixPrecT :: (Pattern a -> QualIdent -> Pattern a -> Pattern a)
          -> Pattern a -> QualIdent -> Pattern a -> PCM (Pattern a)
-fixPrecT infixpatt t1@(NegativePattern _ _) op t2 = do
+fixPrecT infixpatt t1@(NegativePattern _ _ _) op t2 = do
   OpPrec fix pr <- prec op <$> getPrecEnv
   unless (pr < 6 || pr == 6 && fix == InfixL) $
     report $ errInvalidParse "unary operator" minusId op
@@ -366,34 +375,34 @@
 
 fixRPrecT :: (Pattern a -> QualIdent -> Pattern a -> Pattern a)
           -> Pattern a -> QualIdent -> Pattern a -> PCM (Pattern a)
-fixRPrecT infixpatt t1 op t2@(NegativePattern _ _) = do
+fixRPrecT infixpatt t1 op t2@(NegativePattern _ _ _) = do
   OpPrec _ pr <- prec op <$> getPrecEnv
   unless (pr < 6) $ report $ errInvalidParse "unary operator" minusId op
   return $ infixpatt t1 op t2
-fixRPrecT infixpatt t1 op1 (InfixPattern a t2 op2 t3) = do
+fixRPrecT infixpatt t1 op1 (InfixPattern spi a t2 op2 t3) = do
   OpPrec fix1 pr1 <- prec op1 <$> getPrecEnv
   OpPrec fix2 pr2 <- prec op2 <$> getPrecEnv
   if pr1 < pr2 || pr1 == pr2 && fix1 == InfixR && fix2 == InfixR
-    then return $ infixpatt t1 op1 (InfixPattern a t2 op2 t3)
+    then return $ infixpatt t1 op1 (InfixPattern spi a t2 op2 t3)
     else if pr1 > pr2 || pr1 == pr2 && fix1 == InfixL && fix2 == InfixL
       then do
         left <- fixPrecT infixpatt t1 op1 t2
-        return $ InfixPattern a left op2 t3
+        return $ InfixPattern (left @+@ t3) a left op2 t3
       else do
         report $ errAmbiguousParse "operator" op1 op2
-        return $ infixpatt t1 op1 (InfixPattern a t2 op2 t3)
-fixRPrecT infixpatt t1 op1 (InfixFuncPattern a t2 op2 t3) = do
+        return $ infixpatt t1 op1 (InfixPattern spi a t2 op2 t3)
+fixRPrecT infixpatt t1 op1 (InfixFuncPattern spi a t2 op2 t3) = do
   OpPrec fix1 pr1 <- prec op1 <$> getPrecEnv
   OpPrec fix2 pr2 <- prec op2 <$> getPrecEnv
   if pr1 < pr2 || pr1 == pr2 && fix1 == InfixR && fix2 == InfixR
-    then return $ infixpatt t1 op1 (InfixFuncPattern a t2 op2 t3)
+    then return $ infixpatt t1 op1 (InfixFuncPattern spi a t2 op2 t3)
     else if pr1 > pr2 || pr1 == pr2 && fix1 == InfixL && fix2 == InfixL
       then do
         left <- fixPrecT infixpatt t1 op1 t2
-        return $ InfixFuncPattern a left op2 t3
+        return $ InfixFuncPattern (left @+@ t3) a left op2 t3
       else do
         report $ errAmbiguousParse "operator" op1 op2
-        return $ infixpatt t1 op1 (InfixFuncPattern a t2 op2 t3)
+        return $ infixpatt t1 op1 (InfixFuncPattern spi a t2 op2 t3)
 fixRPrecT infixpatt t1 op t2 = return $ infixpatt t1 op t2
 
 {-fixPrecT :: Position -> OpPrecEnv -> Pattern -> QualIdent -> Pattern
@@ -426,12 +435,12 @@
 -- declaration is invalid.
 
 checkOpL :: Ident -> Pattern a -> PCM (Pattern a)
-checkOpL op t@(NegativePattern _ _) = do
+checkOpL op t@(NegativePattern _ _ _) = do
   OpPrec fix pr <- prec (qualify op) <$> getPrecEnv
   unless (pr < 6 || pr == 6 && fix == InfixL) $
     report $ errInvalidParse "unary operator" minusId (qualify op)
   return t
-checkOpL op1 t@(InfixPattern _ _ op2 _) = do
+checkOpL op1 t@(InfixPattern _ _ _ op2 _) = do
   OpPrec fix1 pr1 <- prec (qualify op1) <$> getPrecEnv
   OpPrec fix2 pr2 <- prec op2 <$> getPrecEnv
   unless (pr1 < pr2 || pr1 == pr2 && fix1 == InfixL && fix2 == InfixL) $
@@ -440,11 +449,11 @@
 checkOpL _ t = return t
 
 checkOpR :: Ident -> Pattern a -> PCM (Pattern a)
-checkOpR op t@(NegativePattern _ _) = do
+checkOpR op t@(NegativePattern _ _ _) = do
   OpPrec _ pr <- prec (qualify op)  <$> getPrecEnv
   when (pr >= 6) $ report $ errInvalidParse "unary operator" minusId (qualify op)
   return t
-checkOpR op1 t@(InfixPattern _ _ op2 _) = do
+checkOpR op1 t@(InfixPattern _ _ _ op2 _) = do
   OpPrec fix1 pr1 <- prec (qualify op1)  <$> getPrecEnv
   OpPrec fix2 pr2 <- prec op2  <$> getPrecEnv
   unless (pr1 < pr2 || pr1 == pr2 && fix1 == InfixR && fix2 == InfixR) $
@@ -454,7 +463,7 @@
 
 -- The functions 'opPrec' and 'prec' return the fixity and operator precedence
 -- of an entity. Even though precedence checking is performed after the
--- renaming phase, we have to be prepared to see ambiguous identifiers here.
+-- renaming phase, we have to be prepared to see ambiguoeus identifiers here.
 -- This may happen while checking the root of an operator definition that
 -- shadows an imported definition.
 
@@ -469,6 +478,11 @@
   [] -> defaultP
   PrecInfo _ p : _ -> p
 
+
+-- Combine two entities with SpanInfo to a new SpanInfo (discarding info points)
+(@+@) :: (HasSpanInfo a, HasSpanInfo b) => a -> b -> SpanInfo
+a @+@ b = fromSrcSpan (combineSpans (getSrcSpan a) (getSrcSpan b))
+
 -- ---------------------------------------------------------------------------
 -- Error messages
 -- ---------------------------------------------------------------------------
@@ -487,11 +501,12 @@
 errInvalidParse :: String -> Ident -> QualIdent -> Message
 errInvalidParse what op1 op2 = posMessage op1 $ hsep $ map text
   [ "Invalid use of", what, escName op1, "with", escQualName op2, "in"
-  , showLine $ qidPosition op2]
+  , showLine $ getPosition op2]
 
 -- FIXME: Messages may have missing positions for minus operators
+-- TODO: Is this still true after span update for parser?
 
 errAmbiguousParse :: String -> QualIdent -> QualIdent -> Message
 errAmbiguousParse what op1 op2 = posMessage op1 $ hsep $ map text
   ["Ambiguous use of", what, escQualName op1, "with", escQualName op2, "in"
-  , showLine $ qidPosition op2]
+  , showLine $ getPosition op2]
diff --git a/src/Checks/SyntaxCheck.hs b/src/Checks/SyntaxCheck.hs
--- a/src/Checks/SyntaxCheck.hs
+++ b/src/Checks/SyntaxCheck.hs
@@ -26,10 +26,14 @@
 {-# LANGUAGE CPP #-}
 module Checks.SyntaxCheck (syntaxCheck) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative        ((<$>), (<*>))
 #endif
--- <<<<<<< HEAD
+
 import Control.Monad                      (unless, when)
 import qualified Control.Monad.State as S ( State, runState, gets, modify
                                           , withState )
@@ -44,6 +48,8 @@
 import Curry.Base.Ident
 import Curry.Base.Position
 import Curry.Base.Pretty
+import Curry.Base.Span
+import Curry.Base.SpanInfo
 import Curry.Syntax
 import Curry.Syntax.Pretty (ppPattern)
 
@@ -67,11 +73,13 @@
 -- resulting environment. In addition, this process will also rename the
 -- local variables.
 
+-- TODO: use SpanInfos for errors and then stop passing down SpanInfo from the decls to the checks
+
 syntaxCheck :: [KnownExtension] -> TCEnv -> ValueEnv -> Module ()
             -> ((Module (), [KnownExtension]), [Message])
-syntaxCheck exts tcEnv vEnv mdl@(Module _ m _ _ ds) =
-  case findMultiples $ concatMap constrs tds of
-    []  -> case findMultiples (ls ++ fs ++ cs) of
+syntaxCheck exts tcEnv vEnv mdl@(Module _ _ m _ _ ds) =
+  case findMultiples cons of
+    []  -> case findMultiples (ls ++ fs ++ cons ++ cs) of
              []  -> runSC (checkModule mdl) state
              iss -> ((mdl, exts), map (errMultipleDeclarations m) iss)
     css -> ((mdl, exts), map errMultipleDataConstructor css)
@@ -79,9 +87,10 @@
     tds   = filter isTypeDecl ds
     vds   = filter isValueDecl ds
     cds   = filter isClassDecl ds
+    cons  = concatMap constrs tds
     ls    = nub $ concatMap recLabels tds
     fs    = nub $ concatMap vars vds
-    cs    = concatMap (concatMap methods) $ [ds' | ClassDecl _ _ _ _ ds' <- cds]
+    cs    = concatMap (concatMap methods) [ds' | ClassDecl _ _ _ _ ds' <- cds]
     rEnv  = globalEnv $ fmap renameInfo vEnv
     state = initState exts m tcEnv rEnv
 
@@ -240,7 +249,7 @@
   case maybeF of
     Nothing -> internalError "SyntaxCheck.addFuncPat: no global function set"
     Just  f -> modifyFuncDeps $ \ fd -> fd
-                { globalDeps = Map.insertWith (Set.union) f
+                { globalDeps = Map.insertWith Set.union f
                               (Set.singleton dep) (globalDeps fd) }
 
 -- |Add a functional pattern to `curGlobalFunction'
@@ -366,7 +375,7 @@
 bindFuncDecl tcc m (FunctionDecl _ _ f (eq:_)) env
   = let arty = length $ snd $ getFlatLhs eq
     in  bindGlobal tcc m f (GlobalVar (qualifyWith m f) arty) env
-bindFuncDecl tcc m (TypeSig _ fs (QualTypeExpr _ ty)) env
+bindFuncDecl tcc m (TypeSig _ fs (QualTypeExpr _ _ ty)) env
   = foldr bindTS env $ map (qualifyWith m) fs
   where
     bindTS qf env'
@@ -438,7 +447,7 @@
 -- declaration are allowed to be declared).
 
 checkModule :: Module () -> SCM (Module (), [KnownExtension])
-checkModule (Module ps m es is ds) = do
+checkModule (Module spi ps m es is ds) = do
   mapM_ bindTypeDecl tds
   mapM_ bindClassDecl cds
   ds' <- checkTopDecls ds
@@ -447,7 +456,7 @@
   let ds'' = updateClassAndInstanceDecls cds' ids' ds'
   checkFuncPatDeps
   exts <- getExtensions
-  return (Module ps m es is ds'', exts)
+  return (Module spi ps m es is ds'', exts)
   where tds = filter isTypeDecl ds
         cds = filter isClassDecl ds
         ids = filter isInstanceDecl ds
@@ -542,10 +551,11 @@
   FreeDecl p <$> mapM (checkVar' "free variables declaration") vs
 checkDeclLhs d                            = return d
 
-checkPrecedence :: Position -> Maybe Precedence -> SCM (Maybe Precedence)
+checkPrecedence :: SpanInfo -> Maybe Precedence -> SCM (Maybe Precedence)
 checkPrecedence _ Nothing  = return Nothing
 checkPrecedence p (Just i) = do
-  unless (0 <= i && i <= 9) $ report $ errPrecedenceOutOfRange p i
+  unless (0 <= i && i <= 9) $ report
+                            $ errPrecedenceOutOfRange (spanInfo2Pos p) i
   return $ Just i
 
 checkVar' :: String -> Var a -> SCM (Var a)
@@ -560,26 +570,22 @@
 renameVar :: Ident -> SCM Ident
 renameVar v = renameIdent v <$> getScopeId
 
-checkEquationsLhs :: Position -> [Equation ()] -> SCM (Decl ())
+checkEquationsLhs :: SpanInfo -> [Equation ()] -> SCM (Decl ())
 checkEquationsLhs p [Equation p' lhs rhs] = do
   lhs' <- checkEqLhs p' lhs
   case lhs' of
     Left  l -> return $ funDecl' l
-    Right r -> patDecl' r >>= checkDeclLhs
+    Right r -> checkDeclLhs (PatternDecl p' r rhs)
   where funDecl' (f, lhs') = FunctionDecl p () f [Equation p' lhs' rhs]
-        patDecl' t = do
-          k <- getScopeId
-          when (k == globalScopeId) $ report $ errToplevelPattern p
-          return $ PatternDecl p' t rhs
 checkEquationsLhs _ _ = internalError "SyntaxCheck.checkEquationsLhs"
 
-checkEqLhs :: Position -> Lhs () -> SCM (Either (Ident, Lhs ()) (Pattern ()))
-checkEqLhs p toplhs = do
+checkEqLhs :: SpanInfo -> Lhs () -> SCM (Either (Ident, Lhs ()) (Pattern ()))
+checkEqLhs pspi toplhs = do
   m   <- getModuleIdent
   k   <- getScopeId
   env <- getRenameEnv
   case toplhs of
-    FunLhs f ts
+    FunLhs spi f ts
       | not $ isDataConstr f env -> return left
       | k /= globalScopeId       -> return right
       | null infos               -> return left
@@ -587,9 +593,10 @@
                                        return right
       where f'    = renameIdent f k
             infos = qualLookupVar (qualifyWith m f) env
-            left  = Left  (f', FunLhs f' ts)
-            right = Right $ ConstructorPattern () (qualify f) ts
-    OpLhs t1 op t2
+            left  = Left  (f', FunLhs spi f' ts)
+            right = Right $  -- use start from the parsed FunLhs and compute end
+              updateEndPos $ ConstructorPattern spi () (qualify f) ts
+    OpLhs spi t1 op t2
       | not $ isDataConstr op env -> return left
       | k /= globalScopeId        -> return right
       | null infos                -> return left
@@ -597,28 +604,34 @@
                                         return right
       where op'   = renameIdent op k
             infos = qualLookupVar (qualifyWith m op) env
-            left  = Left (op', OpLhs t1 op' t2)
+            left  = Left (op', OpLhs spi t1 op' t2)
             right = checkOpLhs k env (infixPattern t1 (qualify op)) t2
-            infixPattern (InfixPattern a' t1' op1 t2') op2 t3 =
-              InfixPattern a' t1' op1 (infixPattern t2' op2 t3)
-            infixPattern t1' op1 t2' = InfixPattern () t1' op1 t2'
-    ApLhs lhs ts -> do
-      checked <- checkEqLhs p lhs
+            infixPattern (InfixPattern _ a' t1' op1 t2') op2 t3 =
+              let t2'' = infixPattern t2' op2 t3
+                  sp = combineSpans (getSrcSpan t1') (getSrcSpan t2'')
+              in InfixPattern (fromSrcSpan sp) a' t1' op1 t2''
+            infixPattern t1' op1 t2' =
+              let sp = combineSpans (getSrcSpan t1') (getSrcSpan t2')
+              in InfixPattern (fromSrcSpan sp) () t1' op1 t2'
+    ApLhs spi lhs ts -> do
+      checked <- checkEqLhs pspi lhs
       case checked of
-        Left (f', lhs') -> return $ Left (f', ApLhs lhs' ts)
+        Left (f', lhs') -> return $ Left (f', updateEndPos $ ApLhs spi lhs' ts)
         r               -> do report $ errNonVariable "curried definition" f
                               return $ r
         where (f, _) = flatLhs lhs
+  where p = spanInfo2Pos pspi
 
 checkOpLhs :: Integer -> RenameEnv -> (Pattern a -> Pattern a)
            -> Pattern a -> Either (Ident, Lhs a) (Pattern a)
-checkOpLhs k env f (InfixPattern a t1 op t2)
+checkOpLhs k env f (InfixPattern spi a t1 op t2)
   | isJust m || isDataConstr op' env
-  = checkOpLhs k env (f . InfixPattern a t1 op) t2
+  = checkOpLhs k env (f . InfixPattern spi a t1 op) t2
   | otherwise
-  = Left (op'', OpLhs (f t1) op'' t2)
+  = Left (op'', OpLhs (getSpanInfo t1') t1' op'' t2)
   where (m,op') = (qidModule op, qidIdent op)
         op''    = renameIdent op' k
+        t1'     = f t1
 checkOpLhs _ _ f t = Right (f t)
 
 -- -- ---------------------------------------------------------------------------
@@ -628,7 +641,7 @@
 joinEquations (FunctionDecl a p f eqs : FunctionDecl _ _ f' [eq] : ds)
   | f == f' = do
     when (getArity (head eqs) /= getArity eq) $ report $ errDifferentArity [f, f']
-    joinEquations (FunctionDecl a p f (eqs ++ [eq]) : ds)
+    joinEquations (updateEndPos (FunctionDecl a p f (eqs ++ [eq])) : ds)
   where getArity = length . snd . getFlatLhs
 joinEquations (d : ds) = (d :) <$> joinEquations ds
 
@@ -686,82 +699,82 @@
   rhs' <- checkRhs rhs
   return $ Equation p lhs' rhs'
 
-checkLhs :: Position -> Lhs () -> SCM (Lhs ())
-checkLhs p (FunLhs    f ts) = FunLhs f <$> mapM (checkPattern p) ts
-checkLhs p (OpLhs t1 op t2) = do
+checkLhs :: SpanInfo -> Lhs () -> SCM (Lhs ())
+checkLhs p (FunLhs    spi f ts) = FunLhs spi f <$> mapM (checkPattern p) ts
+checkLhs p (OpLhs spi t1 op t2) = do
   let wrongCalls = concatMap (checkParenPattern (Just $ qualify op)) [t1,t2]
   unless (null wrongCalls) $ report $ errInfixWithoutParens
-    (idPosition op) wrongCalls
-  flip OpLhs op <$> checkPattern p t1 <*> checkPattern p t2
-checkLhs p (ApLhs   lhs ts) =
-  ApLhs <$> checkLhs p lhs <*> mapM (checkPattern p) ts
+    (getPosition op) wrongCalls
+  flip (OpLhs spi) op <$> checkPattern p t1 <*> checkPattern p t2
+checkLhs p (ApLhs   spi lhs ts) =
+  ApLhs spi <$> checkLhs p lhs <*> mapM (checkPattern p) ts
 
 -- checkParen
 -- @param Aufrufende InfixFunktion
 -- @param Pattern
 -- @return Liste mit fehlerhaften Funktionsaufrufen
 
-checkParenPattern :: (Maybe QualIdent) -> Pattern a -> [(QualIdent, QualIdent)]
-checkParenPattern _ (LiteralPattern          _ _) = []
-checkParenPattern _ (NegativePattern         _ _) = []
-checkParenPattern _ (VariablePattern         _ _) = []
-checkParenPattern _ (ConstructorPattern   _ _ cs) =
+checkParenPattern :: Maybe QualIdent -> Pattern a -> [(QualIdent, QualIdent)]
+checkParenPattern _ (LiteralPattern          _ _ _) = []
+checkParenPattern _ (NegativePattern         _ _ _) = []
+checkParenPattern _ (VariablePattern         _ _ _) = []
+checkParenPattern _ (ConstructorPattern   _ _ _ cs) =
   concatMap (checkParenPattern Nothing) cs
-checkParenPattern o (InfixPattern     _ t1 op t2) =
+checkParenPattern o (InfixPattern     _ _ t1 op t2) =
   maybe [] (\c -> [(c, op)]) o
   ++ checkParenPattern Nothing t1 ++ checkParenPattern Nothing t2
-checkParenPattern _ (ParenPattern              t) =
+checkParenPattern _ (ParenPattern              _ t) =
   checkParenPattern Nothing t
-checkParenPattern _ (RecordPattern        _ _ fs) =
+checkParenPattern _ (RecordPattern        _ _ _ fs) =
   concatMap (\(Field _ _ t) -> checkParenPattern Nothing t) fs
-checkParenPattern _ (TuplePattern             ts) =
+checkParenPattern _ (TuplePattern             _ ts) =
   concatMap (checkParenPattern Nothing) ts
-checkParenPattern _ (ListPattern            _ ts) =
+checkParenPattern _ (ListPattern            _ _ ts) =
   concatMap (checkParenPattern Nothing) ts
-checkParenPattern o (AsPattern               _ t) =
+checkParenPattern o (AsPattern               _ _ t) =
   checkParenPattern o t
-checkParenPattern o (LazyPattern               t) =
+checkParenPattern o (LazyPattern               _ t) =
   checkParenPattern o t
-checkParenPattern _ (FunctionPattern      _ _ ts) =
+checkParenPattern _ (FunctionPattern      _ _ _ ts) =
   concatMap (checkParenPattern Nothing) ts
-checkParenPattern o (InfixFuncPattern _ t1 op t2) =
+checkParenPattern o (InfixFuncPattern _ _ t1 op t2) =
   maybe [] (\c -> [(c, op)]) o
   ++ checkParenPattern Nothing t1 ++ checkParenPattern Nothing t2
 
-checkPattern :: Position -> Pattern () -> SCM (Pattern ())
-checkPattern _ (LiteralPattern        a l) =
-  return $ LiteralPattern a l
-checkPattern _ (NegativePattern       a l) =
-  return $ NegativePattern a l
-checkPattern p (VariablePattern       a v)
-  | isAnonId v = (VariablePattern a . renameIdent v) <$> newId
-  | otherwise  = checkConstructorPattern p (qualify v) []
-checkPattern p (ConstructorPattern _ c ts) =
-  checkConstructorPattern p c ts
-checkPattern p (InfixPattern   _ t1 op t2) =
-  checkInfixPattern p t1 op t2
-checkPattern p (ParenPattern            t) =
-  ParenPattern <$> checkPattern p t
-checkPattern p (RecordPattern      _ c fs) =
-  checkRecordPattern p c fs
-checkPattern p (TuplePattern           ts) =
-  TuplePattern <$> mapM (checkPattern p) ts
-checkPattern p (ListPattern          a ts) =
-  ListPattern a <$> mapM (checkPattern p) ts
-checkPattern p (AsPattern             v t) = do
-  AsPattern <$> checkVar "@ pattern" v <*> checkPattern p t
-checkPattern p (LazyPattern             t) = do
+checkPattern :: SpanInfo -> Pattern () -> SCM (Pattern ())
+checkPattern _ (LiteralPattern        spi a l) =
+  return $ LiteralPattern spi a l
+checkPattern _ (NegativePattern       spi a l) =
+  return $ NegativePattern spi a l
+checkPattern p (VariablePattern       spi a v)
+  | isAnonId v = (VariablePattern spi a . renameIdent v) <$> newId
+  | otherwise  = checkConstructorPattern p spi (qualify v) []
+checkPattern p (ConstructorPattern spi _ c ts) =
+  checkConstructorPattern p spi c ts
+checkPattern p (InfixPattern   spi _ t1 op t2) =
+  checkInfixPattern p spi t1 op t2
+checkPattern p (ParenPattern            spi t) =
+  ParenPattern spi <$> checkPattern p t
+checkPattern p (RecordPattern      spi _ c fs) =
+  checkRecordPattern p spi c fs
+checkPattern p (TuplePattern           spi ts) =
+  TuplePattern spi <$> mapM (checkPattern p) ts
+checkPattern p (ListPattern          spi a ts) =
+  ListPattern spi a <$> mapM (checkPattern p) ts
+checkPattern p (AsPattern             spi v t) =
+  AsPattern spi <$> checkVar "@ pattern" v <*> checkPattern p t
+checkPattern p (LazyPattern             spi t) = do
   t' <- checkPattern p t
   banFPTerm "lazy pattern" p t'
-  return (LazyPattern t')
-checkPattern _ (FunctionPattern     _ _ _) = internalError $
+  return (LazyPattern spi t')
+checkPattern _ (FunctionPattern     _ _ _ _) = internalError $
   "SyntaxCheck.checkPattern: function pattern not defined"
-checkPattern _ (InfixFuncPattern  _ _ _ _) = internalError $
+checkPattern _ (InfixFuncPattern  _ _ _ _ _) = internalError $
   "SyntaxCheck.checkPattern: infix function pattern not defined"
 
-checkConstructorPattern :: Position -> QualIdent -> [Pattern ()]
+checkConstructorPattern :: SpanInfo -> SpanInfo -> QualIdent -> [Pattern ()]
                         -> SCM (Pattern ())
-checkConstructorPattern p c ts = do
+checkConstructorPattern p spi c ts = do
   env <- getRenameEnv
   m <- getModuleIdent
   k <- getScopeId
@@ -773,37 +786,37 @@
       [r]          -> processVarFun r k
       []
         | null ts && not (isQualified c) ->
-            return $ VariablePattern () $ renameIdent (unqualify c) k
+            return $ VariablePattern spi () $ renameIdent (unqualify c) k
         | null rs -> do
             ts' <- mapM (checkPattern p) ts
             report $ errUndefinedData c
-            return $ ConstructorPattern () c ts'
+            return $ ConstructorPattern spi () c ts'
       _ -> do ts' <- mapM (checkPattern p) ts
               report $ errAmbiguousData rs c
-              return $ ConstructorPattern () c ts'
+              return $ ConstructorPattern spi () c ts'
   where
   n' = length ts
   processCons qc n = do
     when (n /= n') $ report $ errWrongArity c n n'
-    ConstructorPattern () qc <$> mapM (checkPattern p) ts
+    ConstructorPattern spi () qc <$> mapM (checkPattern p) ts
   processVarFun r k
     | null ts && not (isQualified c)
-    = return $ VariablePattern () $ renameIdent (unqualify c) k -- (varIdent r) k
+    = return $ VariablePattern spi () $ renameIdent (unqualify c) k -- (varIdent r) k
     | otherwise = do
       let n = arity r
-      checkFuncPatsExtension p
+      checkFuncPatsExtension (spanInfo2Pos p)
       checkFuncPatCall r c
       ts' <- mapM (checkPattern p) ts
       mapM_ (checkFPTerm p) ts'
       return $ if n' > n
                  then let (ts1, ts2) = splitAt n ts'
                       in  genFuncPattAppl
-                          (FunctionPattern () (qualVarIdent r) ts1) ts2
-                 else FunctionPattern () (qualVarIdent r) ts'
+                          (FunctionPattern spi () (qualVarIdent r) ts1) ts2
+                 else FunctionPattern spi () (qualVarIdent r) ts'
 
-checkInfixPattern :: Position -> Pattern () -> QualIdent -> Pattern ()
+checkInfixPattern :: SpanInfo -> SpanInfo -> Pattern () -> QualIdent -> Pattern ()
                   -> SCM (Pattern ())
-checkInfixPattern p t1 op t2 = do
+checkInfixPattern p spi t1 op t2 = do
   m <- getModuleIdent
   env <- getRenameEnv
   case qualLookupVar op env of
@@ -812,32 +825,32 @@
     rs           -> case qualLookupVar (qualQualify m op) env of
       [Constr _ n] -> infixPattern (qualQualify m op) n
       [r]          -> funcPattern r (qualQualify m op)
-      rs'          -> do if (null rs && null rs')
+      rs'          -> do if null rs && null rs'
                             then report $ errUndefinedData op
                             else report $ errAmbiguousData rs op
-                         flip (InfixPattern ()) op <$> checkPattern p t1
+                         flip (InfixPattern spi ()) op <$> checkPattern p t1
                                                   <*> checkPattern p t2
   where
   infixPattern qop n = do
     when (n /= 2) $ report $ errWrongArity op n 2
-    flip (InfixPattern ()) qop <$> checkPattern p t1 <*> checkPattern p t2
+    flip (InfixPattern spi ()) qop <$> checkPattern p t1 <*> checkPattern p t2
   funcPattern r qop = do
-    checkFuncPatsExtension p
+    checkFuncPatsExtension (spanInfo2Pos p)
     checkFuncPatCall r qop
     ts'@[t1',t2'] <- mapM (checkPattern p) [t1,t2]
     mapM_ (checkFPTerm p) ts'
-    return $ InfixFuncPattern () t1' qop t2'
+    return $ InfixFuncPattern spi () t1' qop t2'
 
-checkRecordPattern :: Position -> QualIdent -> [Field (Pattern ())]
+checkRecordPattern :: SpanInfo -> SpanInfo -> QualIdent -> [Field (Pattern ())]
                    -> SCM (Pattern ())
-checkRecordPattern p c fs = do
+checkRecordPattern p spi c fs = do
   env <- getRenameEnv
   m   <- getModuleIdent
   case qualLookupVar c env of
     [Constr c' _] -> processRecPat (Just c') fs
     rs            -> case qualLookupVar (qualQualify m c) env of
       [Constr c' _] -> processRecPat (Just c') fs
-      rs'           -> if (null rs && null rs')
+      rs'           -> if null rs && null rs'
                           then do report $ errUndefinedData c
                                   processRecPat Nothing fs
                           else do report $ errAmbiguousData rs c
@@ -846,7 +859,7 @@
   processRecPat mcon fields = do
     fs' <- mapM (checkField (checkPattern p)) fields
     checkFieldLabels "pattern" p mcon fs'
-    return $ RecordPattern () c fs'
+    return $ RecordPattern spi () c fs'
 
 checkFuncPatCall :: RenameInfo -> QualIdent -> SCM ()
 checkFuncPatCall r f = case r of
@@ -857,156 +870,159 @@
 
 -- Note: process decls first
 checkRhs :: Rhs () -> SCM (Rhs ())
-checkRhs (SimpleRhs p e ds) = inNestedScope $
-  flip (SimpleRhs p) <$> checkDeclGroup bindVarDecl ds <*> checkExpr p e
-checkRhs (GuardedRhs es ds) = inNestedScope $
-  flip GuardedRhs <$> checkDeclGroup bindVarDecl ds <*> mapM checkCondExpr es
+checkRhs (SimpleRhs spi e ds) = inNestedScope $
+  flip (SimpleRhs spi) <$> checkDeclGroup bindVarDecl ds <*> checkExpr spi e
+checkRhs (GuardedRhs spi es ds) = inNestedScope $
+  flip (GuardedRhs spi) <$> checkDeclGroup bindVarDecl ds <*> mapM checkCondExpr es
 
 checkCondExpr :: CondExpr () -> SCM (CondExpr ())
-checkCondExpr (CondExpr p g e) =  CondExpr p <$> checkExpr p g <*> checkExpr p e
+checkCondExpr (CondExpr spi g e) =  CondExpr spi <$> checkExpr spi g <*> checkExpr spi e
 
-checkExpr :: Position -> Expression () -> SCM (Expression ())
-checkExpr _ (Literal       a l) = return $ Literal a l
-checkExpr _ (Variable      a v) = checkVariable a v
-checkExpr _ (Constructor   a c) = checkVariable a c
-checkExpr p (Paren           e) = Paren         <$> checkExpr p e
-checkExpr p (Typed        e ty) = flip Typed ty <$> checkExpr p e
-checkExpr p (Record     _ c fs) = checkRecordExpr p c fs
-checkExpr p (RecordUpdate e fs) = checkRecordUpdExpr p e fs
-checkExpr p (Tuple          es) = Tuple <$> mapM (checkExpr p) es
-checkExpr p (List         a es) = List a <$> mapM (checkExpr p) es
-checkExpr p (ListCompr    e qs) = withLocalEnv $ flip ListCompr <$>
+checkExpr :: SpanInfo -> Expression () -> SCM (Expression ())
+checkExpr _ (Literal       spi a l) = return $ Literal spi a l
+checkExpr _ (Variable      spi a v) = checkVariable spi a v
+checkExpr _ (Constructor   spi a c) = checkVariable spi a c
+checkExpr p (Paren         spi   e) = Paren spi           <$> checkExpr p e
+checkExpr p (Typed        spi e ty) = flip (Typed spi) ty <$> checkExpr p e
+checkExpr p (Record     spi _ c fs) = checkRecordExpr p spi c fs
+checkExpr p (RecordUpdate spi e fs) = checkRecordUpdExpr p spi e fs
+checkExpr p (Tuple        spi   es) = Tuple spi <$> mapM (checkExpr p) es
+checkExpr p (List         spi a es) = List spi a <$> mapM (checkExpr p) es
+checkExpr p (ListCompr    spi e qs) = withLocalEnv $ flip (ListCompr spi) <$>
   -- Note: must be flipped to insert qs into RenameEnv first
   mapM (checkStatement "list comprehension" p) qs <*> checkExpr p e
-checkExpr p (EnumFrom              e) = EnumFrom <$> checkExpr p e
-checkExpr p (EnumFromThen      e1 e2) =
-  EnumFromThen <$> checkExpr p e1 <*> checkExpr p e2
-checkExpr p (EnumFromTo        e1 e2) =
-  EnumFromTo <$> checkExpr p e1 <*> checkExpr p e2
-checkExpr p (EnumFromThenTo e1 e2 e3) =
-  EnumFromThenTo <$> checkExpr p e1 <*> checkExpr p e2 <*> checkExpr p e3
-checkExpr p (UnaryMinus            e) = UnaryMinus <$> checkExpr p e
-checkExpr p (Apply             e1 e2) =
-  Apply <$> checkExpr p e1 <*> checkExpr p e2
-checkExpr p (InfixApply     e1 op e2) =
-  InfixApply <$> checkExpr p e1 <*> checkOp op <*> checkExpr p e2
-checkExpr p (LeftSection        e op) =
-  LeftSection <$> checkExpr p e <*> checkOp op
-checkExpr p (RightSection       op e) =
-  RightSection <$> checkOp op <*> checkExpr p e
-checkExpr p (Lambda             ts e) = inNestedScope $ checkLambda p ts e
-checkExpr p (Let                ds e) = inNestedScope $
-  Let <$> checkDeclGroup bindVarDecl ds <*> checkExpr p e
-checkExpr p (Do                sts e) = withLocalEnv $
-  Do <$> mapM (checkStatement "do sequence" p) sts <*> checkExpr p e
-checkExpr p (IfThenElse     e1 e2 e3) =
-  IfThenElse <$> checkExpr p e1 <*> checkExpr p e2 <*> checkExpr p e3
-checkExpr p (Case          ct e alts) =
-  Case ct <$> checkExpr p e <*> mapM checkAlt alts
+checkExpr p (EnumFrom              spi e) = EnumFrom spi <$> checkExpr p e
+checkExpr p (EnumFromThen      spi e1 e2) =
+  EnumFromThen spi <$> checkExpr p e1 <*> checkExpr p e2
+checkExpr p (EnumFromTo        spi e1 e2) =
+  EnumFromTo spi <$> checkExpr p e1 <*> checkExpr p e2
+checkExpr p (EnumFromThenTo spi e1 e2 e3) =
+  EnumFromThenTo spi <$> checkExpr p e1 <*> checkExpr p e2 <*> checkExpr p e3
+checkExpr p (UnaryMinus            spi e) = UnaryMinus spi <$> checkExpr p e
+checkExpr p (Apply             spi e1 e2) =
+  Apply spi <$> checkExpr p e1 <*> checkExpr p e2
+checkExpr p (InfixApply     spi e1 op e2) =
+  InfixApply spi <$> checkExpr p e1 <*> checkOp op <*> checkExpr p e2
+checkExpr p (LeftSection        spi e op) =
+  LeftSection spi <$> checkExpr p e <*> checkOp op
+checkExpr p (RightSection       spi op e) =
+  RightSection spi <$> checkOp op <*> checkExpr p e
+checkExpr p (Lambda             spi ts e) = inNestedScope $ checkLambda p spi ts e
+checkExpr p (Let                spi ds e) = inNestedScope $
+  Let spi <$> checkDeclGroup bindVarDecl ds <*> checkExpr p e
+checkExpr p (Do                spi sts e) = withLocalEnv $
+  Do spi <$> mapM (checkStatement "do sequence" p) sts <*> checkExpr p e
+checkExpr p (IfThenElse     spi e1 e2 e3) =
+  IfThenElse spi <$> checkExpr p e1 <*> checkExpr p e2 <*> checkExpr p e3
+checkExpr p (Case          spi ct e alts) =
+  Case spi ct <$> checkExpr p e <*> mapM checkAlt alts
 
-checkLambda :: Position -> [Pattern ()] -> Expression () -> SCM (Expression ())
-checkLambda p ts e = case findMultiples (bvNoAnon ts) of
+checkLambda :: SpanInfo -> SpanInfo -> [Pattern ()] -> Expression ()
+            -> SCM (Expression ())
+checkLambda p spi ts e = case findMultiples (bvNoAnon ts) of
   []      -> do
     ts' <- mapM (bindPattern "lambda expression" p) ts
-    Lambda ts' <$> checkExpr p e
+    Lambda spi ts' <$> checkExpr p e
   errVars -> do
     mapM_ (report . errDuplicateVariables) errVars
     let nubTs = nubBy (\t1 t2 -> (not . null) (on intersect bvNoAnon t1 t2)) ts
     mapM_ (bindPattern "lambda expression" p) nubTs
-    Lambda ts <$> checkExpr p e
+    Lambda spi ts <$> checkExpr p e
   where
     bvNoAnon t = filter (not . isAnonId) $ bv t
 
-checkVariable :: a -> QualIdent -> SCM (Expression a)
-checkVariable a v
+checkVariable :: SpanInfo -> a -> QualIdent -> SCM (Expression a)
+checkVariable spi a v
     -- anonymous free variable
   | isAnonId (unqualify v) = do
-    checkAnonFreeVarsExtension $ qidPosition v
-    (\n -> Variable a $ updQualIdent id (flip renameIdent n) v) <$> newId
+    checkAnonFreeVarsExtension $ getPosition v
+    (\n -> Variable spi a $ updQualIdent id (flip renameIdent n) v) <$> newId
     -- return $ Variable v
     -- normal variable
   | otherwise             = do
     env <- getRenameEnv
     case qualLookupVar v env of
       []              -> do report $ errUndefinedVariable v
-                            return $ Variable a v
-      [Constr    _ _]   -> return $ Constructor a v
-      [GlobalVar f _]   -> addGlobalDep f >> return (Variable a v)
-      [LocalVar v' _]   -> return $ Variable a $ qualify v' @> v
-      [RecordLabel _ _] -> return $ Variable a v
+                            return $ Variable spi a v
+      [Constr    _ _]   -> return $ Constructor spi a v
+      [GlobalVar f _]   -> addGlobalDep f >> return (Variable spi a v)
+      [LocalVar v' _]   -> return $ Variable spi a $ qualify v' @> v
+      [RecordLabel _ _] -> return $ Variable spi a v
       rs -> do
         m <- getModuleIdent
         case qualLookupVar (qualQualify m v) env of
           []              -> do report $ errAmbiguousIdent rs v
-                                return $ Variable a v
-          [Constr    _ _]   -> return $ Constructor a v
-          [GlobalVar f _]   -> addGlobalDep f >> return (Variable a v)
-          [LocalVar v' _]   -> return $ Variable a $ qualify v' @> v
-          [RecordLabel _ _] -> return $ Variable a v
+                                return $ Variable spi a v
+          [Constr    _ _]   -> return $ Constructor spi a v
+          [GlobalVar f _]   -> addGlobalDep f >> return (Variable spi a v)
+          [LocalVar v' _]   -> return $ Variable spi a $ qualify v' @> v
+          [RecordLabel _ _] -> return $ Variable spi a v
           rs'               -> do report $ errAmbiguousIdent rs' v
-                                  return $ Variable a v
+                                  return $ Variable spi a v
 
-checkRecordExpr :: Position -> QualIdent -> [Field (Expression ())]
+checkRecordExpr :: SpanInfo -> SpanInfo -> QualIdent -> [Field (Expression ())]
                 -> SCM (Expression ())
-checkRecordExpr _ c [] = do
+checkRecordExpr _ spi c [] = do
   m   <- getModuleIdent
   env <- getRenameEnv
   case qualLookupVar c env of
-    [Constr _ _] -> return $ Record () c []
+    [Constr _ _] -> return $ Record spi () c []
     rs           -> case qualLookupVar (qualQualify m c) env of
-      [Constr _ _] -> return $ Record () c []
-      rs'          -> if (null rs && null rs')
+      [Constr _ _] -> return $ Record spi () c []
+      rs'          -> if null rs && null rs'
                          then do report $ errUndefinedData c
-                                 return $ Record () c []
+                                 return $ Record spi () c []
                          else do report $ errAmbiguousData rs c
-                                 return $ Record () c []
-checkRecordExpr p c fs = checkExpr p (RecordUpdate (Constructor () c) fs)
+                                 return $ Record spi () c []
+checkRecordExpr p spi c fs =
+  checkExpr p (RecordUpdate spi (Constructor (getSpanInfo c) () c)
+                fs)
 
-checkRecordUpdExpr :: Position -> Expression () -> [Field (Expression ())]
-                   -> SCM (Expression ())
-checkRecordUpdExpr p e fs = do
+checkRecordUpdExpr :: SpanInfo -> SpanInfo -> Expression ()
+                   -> [Field (Expression ())] -> SCM (Expression ())
+checkRecordUpdExpr p spi e fs = do
   e'  <- checkExpr p e
   fs' <- mapM (checkField (checkExpr p)) fs
   case e' of
-    Constructor a c -> do checkFieldLabels "construction" p (Just c) fs'
-                          return $ Record a c fs'
-    _               -> do checkFieldLabels "update" p Nothing fs'
-                          return $ RecordUpdate e' fs'
+    Constructor _ a c -> do checkFieldLabels "construction" p (Just c) fs'
+                            return $ Record spi a c fs'
+    _                 -> do checkFieldLabels "update" p Nothing fs'
+                            return $ RecordUpdate spi e' fs'
 
 -- * Because patterns or decls eventually introduce new variables, the
 --   scope has to be nested one level.
 -- * Because statements are processed list-wise, inNestedEnv can not be
 --   used as this nesting must be visible to following statements.
-checkStatement :: String -> Position -> Statement () -> SCM (Statement ())
-checkStatement _ p (StmtExpr   e) = StmtExpr <$> checkExpr p e
-checkStatement s p (StmtBind t e) =
-  flip StmtBind <$> checkExpr p e <*> (incNesting >> bindPattern s p t)
-checkStatement _ _ (StmtDecl  ds) =
-  StmtDecl <$> (incNesting >> checkDeclGroup bindVarDecl ds)
+checkStatement :: String -> SpanInfo -> Statement () -> SCM (Statement ())
+checkStatement _ p (StmtExpr spi   e) = StmtExpr spi <$> checkExpr p e
+checkStatement s p (StmtBind spi t e) =
+  flip (StmtBind spi) <$> checkExpr p e <*> (incNesting >> bindPattern s p t)
+checkStatement _ _ (StmtDecl spi  ds) =
+  StmtDecl spi <$> (incNesting >> checkDeclGroup bindVarDecl ds)
 
-bindPattern :: String -> Position -> Pattern () -> SCM (Pattern ())
+bindPattern :: String -> SpanInfo -> Pattern () -> SCM (Pattern ())
 bindPattern s p t = do
   t' <- checkPattern p t
   banFPTerm s p t'
   addBoundVariables True t'
 
-banFPTerm :: String -> Position -> Pattern a -> SCM ()
-banFPTerm _ _ (LiteralPattern           _ _) = ok
-banFPTerm _ _ (NegativePattern          _ _) = ok
-banFPTerm _ _ (VariablePattern          _ _) = ok
-banFPTerm s p (ConstructorPattern    _ _ ts) = mapM_ (banFPTerm s p) ts
-banFPTerm s p (InfixPattern       _ t1 _ t2) = mapM_ (banFPTerm s p) [t1, t2]
-banFPTerm s p (ParenPattern               t) = banFPTerm s p t
-banFPTerm s p (RecordPattern         _ _ fs) = mapM_ banFPTermField fs
+banFPTerm :: String -> SpanInfo -> Pattern a -> SCM ()
+banFPTerm _ _ (LiteralPattern           _ _ _) = ok
+banFPTerm _ _ (NegativePattern          _ _ _) = ok
+banFPTerm _ _ (VariablePattern          _ _ _) = ok
+banFPTerm s p (ConstructorPattern    _ _ _ ts) = mapM_ (banFPTerm s p) ts
+banFPTerm s p (InfixPattern       _ _ t1 _ t2) = mapM_ (banFPTerm s p) [t1, t2]
+banFPTerm s p (ParenPattern               _ t) = banFPTerm s p t
+banFPTerm s p (RecordPattern         _ _ _ fs) = mapM_ banFPTermField fs
   where banFPTermField (Field _ _ x) = banFPTerm s p x
-banFPTerm s p (TuplePattern              ts) = mapM_ (banFPTerm s p) ts
-banFPTerm s p (ListPattern             _ ts) = mapM_ (banFPTerm s p) ts
-banFPTerm s p (AsPattern                _ t) = banFPTerm s p t
-banFPTerm s p (LazyPattern                t) = banFPTerm s p t
-banFPTerm s p pat@(FunctionPattern    _ _ _)
- = report $ errUnsupportedFuncPattern s p pat
-banFPTerm s p pat@(InfixFuncPattern _ _ _ _)
- = report $ errUnsupportedFuncPattern s p pat
+banFPTerm s p (TuplePattern              _ ts) = mapM_ (banFPTerm s p) ts
+banFPTerm s p (ListPattern             _ _ ts) = mapM_ (banFPTerm s p) ts
+banFPTerm s p (AsPattern                _ _ t) = banFPTerm s p t
+banFPTerm s p (LazyPattern                _ t) = banFPTerm s p t
+banFPTerm s p pat@(FunctionPattern    _ _ _ _)
+ = report $ errUnsupportedFuncPattern s (spanInfo2Pos p) pat
+banFPTerm s p pat@(InfixFuncPattern _ _ _ _ _)
+ = report $ errUnsupportedFuncPattern s (spanInfo2Pos p) pat
 
 checkOp :: InfixOp a -> SCM (InfixOp a)
 checkOp op = do
@@ -1028,8 +1044,8 @@
         a = opAnnotation op
 
 checkAlt :: Alt () -> SCM (Alt ())
-checkAlt (Alt p t rhs) = inNestedScope $
-  Alt p <$> bindPattern "case expression" p t <*> checkRhs rhs
+checkAlt (Alt spi t rhs) = inNestedScope $
+  Alt spi <$> bindPattern "case expression" spi t <*> checkRhs rhs
 
 addBoundVariables :: (QuantExpr t) => Bool -> t -> SCM t
 addBoundVariables checkDuplicates ts = do
@@ -1048,7 +1064,7 @@
 -- shadowed by local variables (cf.\ Sect.~3.15.1 of the revised
 -- Haskell'98 report~\cite{PeytonJones03:Haskell}).
 
-checkFieldLabels :: String -> Position -> Maybe QualIdent -> [Field a] -> SCM ()
+checkFieldLabels :: String -> SpanInfo -> Maybe QualIdent -> [Field a] -> SCM ()
 checkFieldLabels what p c fs = do
   mapM checkFieldLabel ls' >>= checkLabels p c ls'
   onJust (report . errDuplicateLabel what) (findDouble ls)
@@ -1075,7 +1091,7 @@
     when (null cs') $ report $ errUndefinedLabel l
     return cs'
 
-checkLabels :: Position -> Maybe QualIdent -> [QualIdent] -> [[QualIdent]]
+checkLabels :: SpanInfo -> Maybe QualIdent -> [QualIdent] -> [[QualIdent]]
             -> SCM ()
 checkLabels _ (Just c) ls css = do
   env <- getRenameEnv
@@ -1085,7 +1101,8 @@
     _             -> internalError $
                        "Checks.SyntaxCheck.checkLabels: " ++ show c
 checkLabels p Nothing ls css =
-  when (null (foldr1 intersect css)) $ report $ errNoCommonCons p ls
+  when (null (foldr1 intersect css))
+    $ report $ errNoCommonCons (spanInfo2Pos p) ls
 
 checkField :: (a -> SCM a) -> Field a -> SCM (Field a)
 checkField check (Field p l x) = Field p l <$> check x
@@ -1188,23 +1205,24 @@
 genFuncPattAppl :: Pattern () -> [Pattern ()] -> Pattern ()
 genFuncPattAppl term []     = term
 genFuncPattAppl term (t:ts)
-   = FunctionPattern () qApplyId [genFuncPattAppl term ts, t]
+   = FunctionPattern NoSpanInfo () qApplyId [genFuncPattAppl term ts, t] -- TODO FIXME major problem
 
-checkFPTerm :: Position -> Pattern a -> SCM ()
-checkFPTerm _ (LiteralPattern        _ _) = ok
-checkFPTerm _ (NegativePattern       _ _) = ok
-checkFPTerm _ (VariablePattern       _ _) = ok
-checkFPTerm p (ConstructorPattern _ _ ts) = mapM_ (checkFPTerm p) ts
-checkFPTerm p (InfixPattern    _ t1 _ t2) = mapM_ (checkFPTerm p) [t1, t2]
-checkFPTerm p (ParenPattern            t) = checkFPTerm p t
-checkFPTerm p (TuplePattern           ts) = mapM_ (checkFPTerm p) ts
-checkFPTerm p (ListPattern          _ ts) = mapM_ (checkFPTerm p) ts
-checkFPTerm p (AsPattern             _ t) = checkFPTerm p t
-checkFPTerm p t@(LazyPattern           _) = report $ errUnsupportedFPTerm "Lazy" p t
-checkFPTerm p (RecordPattern      _ _ fs) = mapM_ (checkFPTerm p)
+checkFPTerm :: SpanInfo -> Pattern a -> SCM ()
+checkFPTerm _ (LiteralPattern        _ _ _) = ok
+checkFPTerm _ (NegativePattern       _ _ _) = ok
+checkFPTerm _ (VariablePattern       _ _ _) = ok
+checkFPTerm p (ConstructorPattern _ _ _ ts) = mapM_ (checkFPTerm p) ts
+checkFPTerm p (InfixPattern    _ _ t1 _ t2) = mapM_ (checkFPTerm p) [t1, t2]
+checkFPTerm p (ParenPattern            _ t) = checkFPTerm p t
+checkFPTerm p (TuplePattern           _ ts) = mapM_ (checkFPTerm p) ts
+checkFPTerm p (ListPattern          _ _ ts) = mapM_ (checkFPTerm p) ts
+checkFPTerm p (AsPattern             _ _ t) = checkFPTerm p t
+checkFPTerm p t@(LazyPattern           _ _) =
+  report $ errUnsupportedFPTerm "Lazy" (spanInfo2Pos p) t
+checkFPTerm p (RecordPattern      _ _ _ fs) = mapM_ (checkFPTerm p)
                                             [ t | Field _ _ t <- fs ]
-checkFPTerm _ (FunctionPattern     _ _ _) = ok -- do not check again
-checkFPTerm _ (InfixFuncPattern  _ _ _ _) = ok -- do not check again
+checkFPTerm _ (FunctionPattern     _ _ _ _) = ok -- do not check again
+checkFPTerm _ (InfixFuncPattern  _ _ _ _ _) = ok -- do not check again
 
 -- ---------------------------------------------------------------------------
 -- Miscellaneous functions
@@ -1226,8 +1244,8 @@
     enableExtension ext -- to avoid multiple warnings
 
 typeArity :: TypeExpr -> Int
-typeArity (ArrowType _ t2) = 1 + typeArity t2
-typeArity _                = 0
+typeArity (ArrowType _ _ t2) = 1 + typeArity t2
+typeArity _                  = 0
 
 getFlatLhs :: Equation a -> (Ident, [Pattern a])
 getFlatLhs (Equation  _ lhs _) = flatLhs lhs
@@ -1388,4 +1406,4 @@
   where
   showCall (q1, q2) = showWithPos q1 <+> text "calls" <+> showWithPos q2
   showWithPos q =  text (qualName q)
-               <+> parens (text $ showLine $ qidPosition q)
+               <+> parens (text $ showLine $ getPosition q)
diff --git a/src/Checks/TypeCheck.hs b/src/Checks/TypeCheck.hs
--- a/src/Checks/TypeCheck.hs
+++ b/src/Checks/TypeCheck.hs
@@ -36,6 +36,10 @@
 {-# LANGUAGE CPP #-}
 module Checks.TypeCheck (typeCheck) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative        ((<$>), (<*>))
 #endif
@@ -55,6 +59,7 @@
 import Curry.Base.Ident
 import Curry.Base.Position
 import Curry.Base.Pretty
+import Curry.Base.SpanInfo
 import Curry.Syntax
 import Curry.Syntax.Pretty
 
@@ -295,8 +300,8 @@
   ok
 checkFieldLabel _ = ok
 
-tcFieldLabel :: [Ident] -> (Ident, Position, TypeExpr)
-             -> TCM (Ident, Position, Type)
+tcFieldLabel :: HasPosition p => [Ident] -> (Ident, p, TypeExpr)
+             -> TCM (Ident, p, Type)
 tcFieldLabel tvs (l, p, ty) = do
   m <- getModuleIdent
   tcEnv <- getTyConsEnv
@@ -310,9 +315,9 @@
   (x, y, z : map thd3 xyzs') : groupLabels xyzs''
   where (xyzs', xyzs'') = partition ((x ==) . fst3) xyzs
 
-tcFieldLabels :: (Ident, Position, [Type]) -> TCM ()
+tcFieldLabels :: HasPosition p => (Ident, p, [Type]) -> TCM ()
 tcFieldLabels (_, _, [])     = return ()
-tcFieldLabels (l, p, ty:tys) = unless (null (filter (ty /=) tys)) $ do
+tcFieldLabels (l, p, ty:tys) = unless (not (any (ty /=) tys)) $ do
   m <- getModuleIdent
   report $ errIncompatibleLabelTypes p m l ty (head tys)
 
@@ -385,7 +390,8 @@
 setDefaults (DefaultDecl _ tys) = mapM toDefaultType tys >>= setDefaultTypes
   where
     toDefaultType =
-      liftM snd . (inst =<<) . liftM typeScheme . expandPoly . QualTypeExpr []
+      liftM snd . (inst =<<) . liftM typeScheme
+                . expandPoly . QualTypeExpr NoSpanInfo []
 setDefaults _ = ok
 
 -- Type Signatures:
@@ -472,7 +478,7 @@
   where implicit pd ~(impPds, expPds) = (pd : impPds, expPds)
         explicit pd qty ~(impPds, expPds) = (impPds, (qty, pd) : expPds)
         typeSig (FunctionDecl _ _ f _) = lookupTypeSig f sigs
-        typeSig (PatternDecl _ (VariablePattern _ v) _) = lookupTypeSig v sigs
+        typeSig (PatternDecl _ (VariablePattern _ _ v) _) = lookupTypeSig v sigs
         typeSig _ = Nothing
 
 bindVars :: ModuleIdent -> ValueEnv -> [(Ident, Int, TypeScheme)] -> ValueEnv
@@ -493,7 +499,7 @@
       tys <- replicateM (n + 1) freshTypeVar
       return [(f, n, monoType $ foldr1 TypeArrow tys)]
 tcDeclVars (PatternDecl _ t _) = case t of
-  VariablePattern _ v -> return <$> tcDeclVar True v
+  VariablePattern _ _ v -> return <$> tcDeclVar True v
   _ -> mapM (tcDeclVar False) (bv t)
 tcDeclVars _ = internalError "TypeCheck.tcDeclVars"
 
@@ -525,7 +531,7 @@
 -- signature. This prevents missing instance errors when the inferred type
 -- of a function is less general than the declared type.
 
-tcFunctionPDecl :: Int -> PredSet -> TypeScheme -> Position -> Ident
+tcFunctionPDecl :: Int -> PredSet -> TypeScheme -> SpanInfo -> Ident
                 -> [Equation a] -> TCM (PredSet, (Type, PDecl PredType))
 tcFunctionPDecl i ps tySc@(ForAll _ pty) p f eqs = do
   (_, ty) <- inst tySc
@@ -538,7 +544,7 @@
 tcEquation fs ty ps eqn@(Equation p lhs rhs) =
   tcEqn fs p lhs rhs >>- unifyDecl p "equation" (ppEquation eqn) ps ty
 
-tcEqn :: Set.Set Int -> Position -> Lhs a -> Rhs a
+tcEqn :: Set.Set Int -> SpanInfo -> Lhs a -> Rhs a
       -> TCM (PredSet, Type, Equation PredType)
 tcEqn fs p lhs rhs = do
   (ps, tys, lhs', ps', ty, rhs') <- withLocalValueEnv $ do
@@ -561,7 +567,7 @@
   ty <- freshTypeVar
   return (v, 0, monoType ty)
 
-unifyDecl :: Position -> String -> Doc -> PredSet -> Type -> PredSet -> Type
+unifyDecl :: HasPosition p => p -> String -> Doc -> PredSet -> Type -> PredSet -> Type
           -> TCM PredSet
 unifyDecl p what doc psLhs tyLhs psRhs tyRhs = do
   ps <- unify p what doc psLhs tyLhs psRhs tyRhs
@@ -579,12 +585,12 @@
 defaultPDecl fvs ps ty (_, FunctionDecl p _ f _) =
   applyDefaultsDecl p ("function " ++ escName f) empty fvs ps ty
 defaultPDecl fvs ps ty (_, PatternDecl p t _) = case t of
-  VariablePattern _ v ->
+  VariablePattern _ _ v ->
     applyDefaultsDecl p ("variable " ++ escName v) empty fvs ps ty
   _ -> return ps
 defaultPDecl _ _ _ _ = internalError "TypeCheck.defaultPDecl"
 
-applyDefaultsDecl :: Position -> String -> Doc -> Set.Set Int -> PredSet -> Type
+applyDefaultsDecl :: HasPosition p => p -> String -> Doc -> Set.Set Int -> PredSet -> Type
                   -> TCM PredSet
 applyDefaultsDecl p what doc fvs ps ty = do
   theta <- getTypeSubst
@@ -602,14 +608,15 @@
 fixType ~(ForAll _ pty) (i, FunctionDecl p _ f eqs) =
   (i, FunctionDecl p pty f eqs)
 fixType ~(ForAll _ pty) pd@(i, PatternDecl p t rhs) = case t of
-  VariablePattern _ v -> (i, PatternDecl p (VariablePattern pty v) rhs)
+  VariablePattern spi _ v
+    -> (i, PatternDecl p (VariablePattern spi pty v) rhs)
   _ -> pd
 fixType _ _ = internalError "TypeCheck.fixType"
 
 declVars :: Decl PredType -> [(Ident, Int, TypeScheme)]
 declVars (FunctionDecl _ pty f eqs) = [(f, eqnArity $ head eqs, typeScheme pty)]
 declVars (PatternDecl _ t _) = case t of
-  VariablePattern pty v -> [(v, 0, typeScheme pty)]
+  VariablePattern _ pty v -> [(v, 0, typeScheme pty)]
   _ -> []
 declVars _ = internalError "TypeCheck.declVars"
 
@@ -642,12 +649,12 @@
     m <- getModuleIdent
     report $ errTypeSigTooGeneral p m (text "Function:" <+> ppIdent f) qty tySc
   return (ps, (i, FunctionDecl p pty f eqs))
-checkPDeclType qty ps tySc (i, PatternDecl p (VariablePattern _ v) rhs) = do
+checkPDeclType qty ps tySc (i, PatternDecl p (VariablePattern spi _ v) rhs) = do
   pty <- expandPoly qty
   unlessM (checkTypeSig pty tySc) $ do
     m <- getModuleIdent
     report $ errTypeSigTooGeneral p m (text "Variable:" <+> ppIdent v) qty tySc
-  return (ps, (i, PatternDecl p (VariablePattern pty v) rhs))
+  return (ps, (i, PatternDecl p (VariablePattern spi pty v) rhs))
 checkPDeclType _ _ _ _ = internalError "TypeCheck.checkPDeclType"
 
 checkTypeSig :: PredType -> TypeScheme -> TCM Bool
@@ -744,7 +751,7 @@
     sigs <- getSigEnv
     modifyValueEnv $ flip (foldr (bindDeclArity m tcEnv clsEnv sigs)) ds
     isNonExpansive e &&^ isNonExpansive ds
-  isNonExpansive (GuardedRhs   _ _) = return False
+  isNonExpansive (GuardedRhs _ _ _) = return False
 
 -- A record construction is non-expansive only if all field labels are present.
 
@@ -752,8 +759,8 @@
   isNonExpansive = isNonExpansive' 0
 
 isNonExpansive' :: Int -> Expression a -> TCM Bool
-isNonExpansive' _ (Literal         _ _) = return True
-isNonExpansive' n (Variable        _ v)
+isNonExpansive' _ (Literal         _ _ _) = return True
+isNonExpansive' n (Variable        _ _ v)
   | v' == anonId = return False
   | isRenamed v' = do
     vEnv <- getValueEnv
@@ -762,27 +769,27 @@
     vEnv <- getValueEnv
     return $ n < varArity v vEnv
   where v' = unqualify v
-isNonExpansive' _ (Constructor     _ _) = return True
-isNonExpansive' n (Paren             e) = isNonExpansive' n e
-isNonExpansive' n (Typed           e _) = isNonExpansive' n e
-isNonExpansive' _ (Record       _ c fs) = do
+isNonExpansive' _ (Constructor     _ _ _) = return True
+isNonExpansive' n (Paren             _ e) = isNonExpansive' n e
+isNonExpansive' n (Typed           _ e _) = isNonExpansive' n e
+isNonExpansive' _ (Record       _ _ c fs) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   liftM ((length (constrLabels m c vEnv) == length fs) &&) (isNonExpansive fs)
-isNonExpansive' _ (Tuple            es) = isNonExpansive es
-isNonExpansive' _ (List           _ es) = isNonExpansive es
-isNonExpansive' n (Apply           f e) =
+isNonExpansive' _ (Tuple            _ es) = isNonExpansive es
+isNonExpansive' _ (List           _ _ es) = isNonExpansive es
+isNonExpansive' n (Apply           _ f e) =
   isNonExpansive' (n + 1) f &&^ isNonExpansive e
-isNonExpansive' n (InfixApply e1 op e2) =
+isNonExpansive' n (InfixApply _ e1 op e2) =
   isNonExpansive' (n + 2) (infixOp op) &&^ isNonExpansive e1 &&^
     isNonExpansive e2
-isNonExpansive' n (LeftSection    e op) =
+isNonExpansive' n (LeftSection    _ e op) =
   isNonExpansive' (n + 1) (infixOp op) &&^ isNonExpansive e
-isNonExpansive' n (Lambda         ts e) = withLocalValueEnv $ do
+isNonExpansive' n (Lambda         _ ts e) = withLocalValueEnv $ do
   modifyValueEnv $ flip (foldr bindVarArity) (bv ts)
   liftM ((n < length ts) ||)
     (liftM ((all isVariablePattern ts) &&) (isNonExpansive' (n - length ts) e))
-isNonExpansive' n (Let            ds e) = withLocalValueEnv $ do
+isNonExpansive' n (Let            _ ds e) = withLocalValueEnv $ do
   m <- getModuleIdent
   tcEnv <- getTyConsEnv
   clsEnv <- getClassEnv
@@ -858,7 +865,7 @@
 tcTopPDecl (i, InstanceDecl p cx qcls ty ds) = do
   tcEnv <- getTyConsEnv
   let ocls = origName $ head $ qualLookupTypeInfo qcls tcEnv
-  pty <- expandPoly $ QualTypeExpr cx ty
+  pty <- expandPoly $ QualTypeExpr NoSpanInfo cx ty
   vpds' <- mapM (tcInstanceMethodPDecl ocls pty) vpds
   return (i, InstanceDecl p cx qcls ty $ fromPDecls $ map untyped opds ++ vpds')
   where (vpds, opds) = partition (isValueDecl . snd) $ toPDecls ds
@@ -869,8 +876,9 @@
   methTy <- classMethodType qualify f
   (tySc, pd') <- tcMethodPDecl methTy pd
   sigs <- getSigEnv
-  let QualTypeExpr cx ty = fromJust $ lookupTypeSig f sigs
-      qty = QualTypeExpr (Constraint qcls (VariableType tv) : cx) ty
+  let QualTypeExpr spi cx ty = fromJust $ lookupTypeSig f sigs
+      qty = QualTypeExpr spi
+              (Constraint NoSpanInfo qcls (VariableType NoSpanInfo tv) : cx) ty
   checkClassMethodType qty tySc pd'
 tcClassMethodPDecl _ _ _ = internalError "TypeCheck.tcClassMethodPDecl"
 
@@ -933,9 +941,9 @@
   sigs <- getSigEnv
   case lookupTypeSig f sigs of
     Nothing -> internalError "TypeCheck.tcExternal: type signature not found"
-    Just (QualTypeExpr _ ty) -> do
+    Just (QualTypeExpr _ _ ty) -> do
       m <- getModuleIdent
-      PredType _ ty' <- expandPoly $ QualTypeExpr [] ty
+      PredType _ ty' <- expandPoly $ QualTypeExpr NoSpanInfo [] ty
       modifyValueEnv $ bindFun m f False (arrowArity ty') (polyType ty')
       return ty'
 
@@ -955,18 +963,18 @@
   | otherwise = liftM ((,) emptyPredSet) (freshConstrained fractionalTypes)
 tcLiteral _ (String _) = return (emptyPredSet, stringType)
 
-tcLhs :: Position -> Lhs a -> TCM (PredSet, [Type], Lhs PredType)
-tcLhs p (FunLhs f ts) = do
+tcLhs :: HasPosition p => p -> Lhs a -> TCM (PredSet, [Type], Lhs PredType)
+tcLhs p (FunLhs spi f ts) = do
   (pss, tys, ts') <- liftM unzip3 $ mapM (tcPattern p) ts
-  return (Set.unions pss, tys, FunLhs f ts')
-tcLhs p (OpLhs t1 op t2) = do
+  return (Set.unions pss, tys, FunLhs spi f ts')
+tcLhs p (OpLhs spi t1 op t2) = do
   (ps1, ty1, t1') <- tcPattern p t1
   (ps2, ty2, t2') <- tcPattern p t2
-  return (ps1 `Set.union` ps2, [ty1, ty2], OpLhs t1' op t2')
-tcLhs p (ApLhs lhs ts) = do
+  return (ps1 `Set.union` ps2, [ty1, ty2], OpLhs spi t1' op t2')
+tcLhs p (ApLhs spi lhs ts) = do
   (ps, tys1, lhs') <- tcLhs p lhs
   (pss, tys2, ts') <- liftM unzip3 $ mapM (tcPattern p) ts
-  return (Set.unions (ps:pss), tys1 ++ tys2, ApLhs lhs' ts')
+  return (Set.unions (ps:pss), tys1 ++ tys2, ApLhs spi lhs' ts')
 
 -- When computing the type of a variable in a pattern, we ignore the
 -- predicate set of the variable's type (which can only be due to a type
@@ -975,76 +983,76 @@
 -- checked as constructor and functional patterns, respectively, resulting
 -- in slighty misleading error messages if the type check fails.
 
-tcPattern :: Position -> Pattern a -> TCM (PredSet, Type, Pattern PredType)
-tcPattern _ (LiteralPattern _ l) = do
+tcPattern :: HasPosition p => p -> Pattern a -> TCM (PredSet, Type, Pattern PredType)
+tcPattern _ (LiteralPattern spi _ l) = do
   (ps, ty) <- tcLiteral False l
-  return (ps, ty, LiteralPattern (predType ty) l)
-tcPattern _ (NegativePattern _ l) = do
+  return (ps, ty, LiteralPattern spi (predType ty) l)
+tcPattern _ (NegativePattern spi _ l) = do
   (ps, ty) <- tcLiteral False l
-  return (ps, ty, NegativePattern (predType ty) l)
-tcPattern _ (VariablePattern _ v) = do
+  return (ps, ty, NegativePattern spi (predType ty) l)
+tcPattern _ (VariablePattern spi _ v) = do
   vEnv <- getValueEnv
   (_, ty) <- inst (varType v vEnv)
-  return (emptyPredSet, ty, VariablePattern (predType ty) v)
-tcPattern p t@(ConstructorPattern _ c ts) = do
+  return (emptyPredSet, ty, VariablePattern spi (predType ty) v)
+tcPattern p t@(ConstructorPattern spi _ c ts) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, (tys, ty')) <- liftM (fmap arrowUnapply) (skol (constrType m c vEnv))
   (ps', ts') <- mapAccumM (uncurry . tcPatternArg p "pattern" (ppPattern 0 t)) ps (zip tys ts)
-  return (ps', ty', ConstructorPattern (predType ty') c ts')
-tcPattern p (InfixPattern a t1 op t2) = do
-  (ps, ty, ConstructorPattern a' op' [t1', t2']) <-
-    tcPattern p (ConstructorPattern a op [t1, t2])
-  return (ps, ty, InfixPattern a' t1' op' t2')
-tcPattern p (ParenPattern t) = do
+  return (ps', ty', ConstructorPattern spi (predType ty') c ts')
+tcPattern p (InfixPattern spi a t1 op t2) = do
+  (ps, ty, ConstructorPattern _ a' op' [t1', t2']) <-
+    tcPattern p (ConstructorPattern NoSpanInfo a op [t1, t2])
+  return (ps, ty, InfixPattern spi a' t1' op' t2')
+tcPattern p (ParenPattern spi t) = do
   (ps, ty, t') <- tcPattern p t
-  return (ps, ty, ParenPattern t')
-tcPattern _ t@(RecordPattern _ c fs) = do
+  return (ps, ty, ParenPattern spi t')
+tcPattern _ t@(RecordPattern spi _ c fs) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, ty) <- liftM (fmap arrowBase) (skol (constrType m c vEnv))
   (ps', fs') <- mapAccumM (tcField tcPattern "pattern" (\t' -> ppPattern 0 t $-$ text "Term:" <+> ppPattern 0 t') ty) ps fs
-  return (ps', ty, RecordPattern (predType ty) c fs')
-tcPattern p (TuplePattern ts) = do
+  return (ps', ty, RecordPattern spi (predType ty) c fs')
+tcPattern p (TuplePattern spi ts) = do
   (pss, tys, ts') <- liftM unzip3 $ mapM (tcPattern p) ts
-  return (Set.unions pss, tupleType tys, TuplePattern ts')
-tcPattern p t@(ListPattern _ ts) = do
+  return (Set.unions pss, tupleType tys, TuplePattern spi ts')
+tcPattern p t@(ListPattern spi _ ts) = do
   ty <- freshTypeVar
   (ps, ts') <- mapAccumM (flip (tcPatternArg p "pattern" (ppPattern 0 t)) ty) emptyPredSet ts
-  return (ps, listType ty, ListPattern (predType $ listType ty) ts')
-tcPattern p t@(AsPattern v t') = do
+  return (ps, listType ty, ListPattern spi (predType $ listType ty) ts')
+tcPattern p t@(AsPattern spi v t') = do
   vEnv <- getValueEnv
   (_, ty) <- inst (varType v vEnv)
   (ps, t'') <- tcPattern p t' >>-
     unify p "pattern" (ppPattern 0 t) emptyPredSet ty
-  return (ps, ty, AsPattern v t'')
-tcPattern p (LazyPattern t) = do
+  return (ps, ty, AsPattern spi v t'')
+tcPattern p (LazyPattern spi t) = do
   (ps, ty, t') <- tcPattern p t
-  return (ps, ty, LazyPattern t')
-tcPattern p t@(FunctionPattern _ f ts) = do
+  return (ps, ty, LazyPattern spi t')
+tcPattern p t@(FunctionPattern spi _ f ts) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, ty) <- inst (funType m f vEnv)
-  tcFuncPattern p (ppPattern 0 t) f id ps ty ts
-tcPattern p (InfixFuncPattern a t1 op t2) = do
-  (ps, ty, FunctionPattern a' op' [t1', t2']) <-
-    tcPattern p (FunctionPattern a op [t1, t2])
-  return (ps, ty, InfixFuncPattern a' t1' op' t2')
+  tcFuncPattern p spi (ppPattern 0 t) f id ps ty ts
+tcPattern p (InfixFuncPattern spi a t1 op t2) = do
+  (ps, ty, FunctionPattern _ a' op' [t1', t2']) <-
+    tcPattern p (FunctionPattern spi a op [t1, t2])
+  return (ps, ty, InfixFuncPattern spi a' t1' op' t2')
 
-tcFuncPattern :: Position -> Doc -> QualIdent
+tcFuncPattern :: HasPosition p => p -> SpanInfo -> Doc -> QualIdent
               -> ([Pattern PredType] -> [Pattern PredType])
               -> PredSet -> Type -> [Pattern a]
               -> TCM (PredSet, Type, Pattern PredType)
-tcFuncPattern _ _ f ts ps ty [] =
-  return (ps, ty, FunctionPattern (predType ty) f (ts []))
-tcFuncPattern p doc f ts ps ty (t':ts') = do
+tcFuncPattern _ spi _ f ts ps ty [] =
+  return (ps, ty, FunctionPattern spi (predType ty) f (ts []))
+tcFuncPattern p spi doc f ts ps ty (t':ts') = do
   (alpha, beta) <-
     tcArrow p "functional pattern" (doc $-$ text "Term:" <+> ppPattern 0 t) ty
   (ps', t'') <- tcPatternArg p "functional pattern" doc ps alpha t'
-  tcFuncPattern p doc f (ts . (t'' :)) ps' beta ts'
-  where t = FunctionPattern (predType ty) f (ts [])
+  tcFuncPattern p spi doc f (ts . (t'' :)) ps' beta ts'
+  where t = FunctionPattern spi (predType ty) f (ts [])
 
-tcPatternArg :: Position -> String -> Doc -> PredSet -> Type
+tcPatternArg :: HasPosition p => p -> String -> Doc -> PredSet -> Type
              -> Pattern a -> TCM (PredSet, Pattern PredType)
 tcPatternArg p what doc ps ty t =
   tcPattern p t >>-
@@ -1058,11 +1066,11 @@
     return (ps, ds', ps', ty, e')
   ps'' <- reducePredSet p "expression" (ppExpr 0 e') (ps `Set.union` ps')
   return (ps'', ty, SimpleRhs p e' ds')
-tcRhs (GuardedRhs es ds) = withLocalValueEnv $ do
+tcRhs (GuardedRhs spi es ds) = withLocalValueEnv $ do
   (ps, ds') <- tcDecls ds
   ty <- freshTypeVar
   (ps', es') <- mapAccumM (tcCondExpr ty) ps es
-  return (ps', ty, GuardedRhs es' ds')
+  return (ps', ty, GuardedRhs spi es' ds')
 
 tcCondExpr :: Type -> PredSet -> CondExpr a -> TCM (PredSet, CondExpr PredType)
 tcCondExpr ty ps (CondExpr p g e) = do
@@ -1070,25 +1078,25 @@
   (ps'', e') <- tcExpr p e >>- unify p "guarded expression" (ppExpr 0 e) ps' ty
   return (ps'', CondExpr p g' e')
 
-tcExpr :: Position -> Expression a -> TCM (PredSet, Type, Expression PredType)
-tcExpr _ (Literal _ l) = do
+tcExpr :: HasPosition p => p -> Expression a -> TCM (PredSet, Type, Expression PredType)
+tcExpr _ (Literal spi _ l) = do
   (ps, ty) <- tcLiteral True l
-  return (ps, ty, Literal (predType ty) l)
-tcExpr _ (Variable _ v) = do
+  return (ps, ty, Literal spi (predType ty) l)
+tcExpr _ (Variable spi _ v) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, ty) <- if isAnonId (unqualify v) then freshPredType []
                                         else inst (funType m v vEnv)
-  return (ps, ty, Variable (predType ty) v)
-tcExpr _ (Constructor _ c) = do
+  return (ps, ty, Variable spi (predType ty) v)
+tcExpr _ (Constructor spi _ c) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, ty) <- instExist (constrType m c vEnv)
-  return (ps, ty, Constructor (predType ty) c)
-tcExpr p (Paren e) = do
+  return (ps, ty, Constructor spi (predType ty) c)
+tcExpr p (Paren spi e) = do
   (ps, ty, e') <- tcExpr p e
-  return (ps, ty, Paren e')
-tcExpr p (Typed e qty) = do
+  return (ps, ty, Paren spi e')
+tcExpr p (Typed spi e qty) = do
   pty <- expandPoly qty
   (ps, ty) <- inst (typeScheme pty)
   (ps', e') <- tcExpr p e >>-
@@ -1101,26 +1109,26 @@
     m <- getModuleIdent
     report $
       errTypeSigTooGeneral p m (text "Expression:" <+> ppExpr 0 e) qty tySc
-  return (ps `Set.union` gps, ty, Typed e' qty)
-tcExpr _ e@(Record _ c fs) = do
+  return (ps `Set.union` gps, ty, Typed spi e' qty)
+tcExpr _ e@(Record spi _ c fs) = do
   m <- getModuleIdent
   vEnv <- getValueEnv
   (ps, ty) <- liftM (fmap arrowBase) (instExist (constrType m c vEnv))
   (ps', fs') <- mapAccumM (tcField tcExpr "construction" (\e' -> ppExpr 0 e $-$ text "Term:" <+> ppExpr 0 e') ty) ps fs
-  return (ps', ty, Record (predType ty) c fs')
-tcExpr p e@(RecordUpdate e1 fs) = do
+  return (ps', ty, Record spi (predType ty) c fs')
+tcExpr p e@(RecordUpdate spi e1 fs) = do
   (ps, ty, e1') <- tcExpr p e1
   (ps', fs') <- mapAccumM (tcField tcExpr "update" (\e' -> ppExpr 0 e $-$ text "Term:" <+> ppExpr 0 e') ty) ps fs
-  return (ps', ty, RecordUpdate e1' fs')
-tcExpr p (Tuple es) = do
+  return (ps', ty, RecordUpdate spi e1' fs')
+tcExpr p (Tuple spi es) = do
   (pss, tys, es') <- liftM unzip3 $ mapM (tcExpr p) es
-  return (Set.unions pss, tupleType tys, Tuple es')
-tcExpr p e@(List _ es) = do
+  return (Set.unions pss, tupleType tys, Tuple spi es')
+tcExpr p e@(List spi _ es) = do
   ty <- freshTypeVar
   (ps, es') <-
     mapAccumM (flip (tcArg p "expression" (ppExpr 0 e)) ty) emptyPredSet es
-  return (ps, listType ty, List (predType $ listType ty) es')
-tcExpr p (ListCompr e qs) = do
+  return (ps, listType ty, List spi (predType $ listType ty) es')
+tcExpr p (ListCompr spi e qs) = do
   fs <- computeFsEnv
   (ps, qs', ps', ty, e') <- withLocalValueEnv $ do
     (ps, qs') <- mapAccumM (tcQual p) emptyPredSet qs
@@ -1128,53 +1136,53 @@
     return (ps, qs', ps', ty, e')
   ps'' <- reducePredSet p "expression" (ppExpr 0 e') (ps `Set.union` ps')
   checkSkolems p "Expression" (ppExpr 0) fs ps'' (listType ty)
-    (ListCompr e' qs')
-tcExpr p e@(EnumFrom e1) = do
+    (ListCompr spi e' qs')
+tcExpr p e@(EnumFrom spi e1) = do
   (ps, ty) <- freshEnumType
   (ps', e1') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps ty e1
-  return (ps', listType ty, EnumFrom e1')
-tcExpr p e@(EnumFromThen e1 e2) = do
+  return (ps', listType ty, EnumFrom spi e1')
+tcExpr p e@(EnumFromThen spi e1 e2) = do
   (ps, ty) <- freshEnumType
   (ps', e1') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps ty e1
   (ps'', e2') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps' ty e2
-  return (ps'', listType ty, EnumFromThen e1' e2')
-tcExpr p e@(EnumFromTo e1 e2) = do
+  return (ps'', listType ty, EnumFromThen spi e1' e2')
+tcExpr p e@(EnumFromTo spi e1 e2) = do
   (ps, ty) <- freshEnumType
   (ps', e1') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps ty e1
   (ps'', e2') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps' ty e2
-  return (ps'', listType ty, EnumFromTo e1' e2')
-tcExpr p e@(EnumFromThenTo e1 e2 e3) = do
+  return (ps'', listType ty, EnumFromTo spi e1' e2')
+tcExpr p e@(EnumFromThenTo spi e1 e2 e3) = do
   (ps, ty) <- freshEnumType
   (ps', e1') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps ty e1
   (ps'', e2') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps' ty e2
   (ps''', e3') <- tcArg p "arithmetic sequence" (ppExpr 0 e) ps'' ty e3
-  return (ps''', listType ty, EnumFromThenTo e1' e2' e3')
-tcExpr p e@(UnaryMinus e1) = do
+  return (ps''', listType ty, EnumFromThenTo spi e1' e2' e3')
+tcExpr p e@(UnaryMinus spi e1) = do
   (ps, ty) <- freshNumType
   (ps', e1') <- tcArg p "unary negation" (ppExpr 0 e) ps ty e1
-  return (ps', ty, UnaryMinus e1')
-tcExpr p e@(Apply e1 e2) = do
+  return (ps', ty, UnaryMinus spi e1')
+tcExpr p e@(Apply spi e1 e2) = do
   (ps, (alpha, beta), e1') <- tcExpr p e1 >>=-
     tcArrow p "application" (ppExpr 0 e $-$ text "Term:" <+> ppExpr 0 e1)
   (ps', e2') <- tcArg p "application" (ppExpr 0 e) ps alpha e2
-  return (ps', beta, Apply e1' e2')
-tcExpr p e@(InfixApply e1 op e2) = do
+  return (ps', beta, Apply spi e1' e2')
+tcExpr p e@(InfixApply spi e1 op e2) = do
   (ps, (alpha, beta, gamma), op') <- tcInfixOp op >>=-
     tcBinary p "infix application" (ppExpr 0 e $-$ text "Operator:" <+> ppOp op)
   (ps', e1') <- tcArg p "infix application" (ppExpr 0 e) ps alpha e1
   (ps'', e2') <- tcArg p "infix application" (ppExpr 0 e) ps' beta e2
-  return (ps'', gamma, InfixApply e1' op' e2')
-tcExpr p e@(LeftSection e1 op) = do
+  return (ps'', gamma, InfixApply spi e1' op' e2')
+tcExpr p e@(LeftSection spi e1 op) = do
   (ps, (alpha, beta), op') <- tcInfixOp op >>=-
     tcArrow p "left section" (ppExpr 0 e $-$ text "Operator:" <+> ppOp op)
   (ps', e1') <- tcArg p "left section" (ppExpr 0 e) ps alpha e1
-  return (ps', beta, LeftSection e1' op')
-tcExpr p e@(RightSection op e1) = do
+  return (ps', beta, LeftSection spi e1' op')
+tcExpr p e@(RightSection spi op e1) = do
   (ps, (alpha, beta, gamma), op') <- tcInfixOp op >>=-
     tcBinary p "right section" (ppExpr 0 e $-$ text "Operator:" <+> ppOp op)
   (ps', e1') <- tcArg p "right section" (ppExpr 0 e) ps beta e1
-  return (ps', TypeArrow alpha gamma, RightSection op' e1')
-tcExpr p (Lambda ts e) = do
+  return (ps', TypeArrow alpha gamma, RightSection spi op' e1')
+tcExpr p (Lambda spi ts e) = do
   fs <- computeFsEnv
   (pss, tys, ts', ps, ty, e')<- withLocalValueEnv $ do
     bindLambdaVars ts
@@ -1183,16 +1191,16 @@
     return (pss, tys, ts', ps, ty, e')
   ps' <- reducePredSet p "expression" (ppExpr 0 e') (Set.unions $ ps : pss)
   checkSkolems p "Expression" (ppExpr 0) fs ps' (foldr TypeArrow ty tys)
-    (Lambda ts' e')
-tcExpr p (Let ds e) = do
+    (Lambda spi ts' e')
+tcExpr p (Let spi ds e) = do
   fs <- computeFsEnv
   (ps, ds', ps', ty, e') <- withLocalValueEnv $ do
     (ps, ds') <- tcDecls ds
     (ps', ty, e') <- tcExpr p e
     return (ps, ds', ps', ty, e')
   ps'' <- reducePredSet p "expression" (ppExpr 0 e') (ps `Set.union` ps')
-  checkSkolems p "Expression" (ppExpr 0) fs ps'' ty (Let ds' e')
-tcExpr p (Do sts e) = do
+  checkSkolems p "Expression" (ppExpr 0) fs ps'' ty (Let spi ds' e')
+tcExpr p (Do spi sts e) = do
   fs <- computeFsEnv
   (sts', ty, ps', e') <- withLocalValueEnv $ do
     ((ps, mTy), sts') <-
@@ -1200,20 +1208,20 @@
     ty <- liftM (maybe id TypeApply mTy) freshTypeVar
     (ps', e') <- tcExpr p e >>- unify p "statement" (ppExpr 0 e) ps ty
     return (sts', ty, ps', e')
-  checkSkolems p "Expression" (ppExpr 0) fs ps' ty (Do sts' e')
-tcExpr p e@(IfThenElse e1 e2 e3) = do
+  checkSkolems p "Expression" (ppExpr 0) fs ps' ty (Do spi sts' e')
+tcExpr p e@(IfThenElse spi e1 e2 e3) = do
   (ps, e1') <- tcArg p "expression" (ppExpr 0 e) emptyPredSet boolType e1
   (ps', ty, e2') <- tcExpr p e2
   (ps'', e3') <- tcArg p "expression" (ppExpr 0 e) (ps `Set.union` ps') ty e3
-  return (ps'', ty, IfThenElse e1' e2' e3')
-tcExpr p (Case ct e as) = do
+  return (ps'', ty, IfThenElse spi e1' e2' e3')
+tcExpr p (Case spi ct e as) = do
   (ps, tyLhs, e') <- tcExpr p e
   tyRhs <- freshTypeVar
   fs <- computeFsEnv
   (ps', as') <- mapAccumM (tcAlt fs tyLhs tyRhs) ps as
-  return (ps', tyRhs, Case ct e' as')
+  return (ps', tyRhs, Case spi ct e' as')
 
-tcArg :: Position -> String -> Doc -> PredSet -> Type -> Expression a
+tcArg :: HasPosition p => p -> String -> Doc -> PredSet -> Type -> Expression a
       -> TCM (PredSet, Expression PredType)
 tcArg p what doc ps ty e =
   tcExpr p e >>- unify p what (doc $-$ text "Term:" <+> ppExpr 0 e) ps ty
@@ -1224,7 +1232,7 @@
   tcAltern fs tyLhs p t rhs >>-
     unify p "case alternative" (ppAlt a) ps tyRhs
 
-tcAltern :: Set.Set Int -> Type -> Position -> Pattern a
+tcAltern :: Set.Set Int -> Type -> SpanInfo -> Pattern a
          -> Rhs a -> TCM (PredSet, Type, Alt PredType)
 tcAltern fs tyLhs p t rhs = do
   (ps, t', ps', ty', rhs') <- withLocalValueEnv $ do
@@ -1236,40 +1244,40 @@
   ps'' <- reducePredSet p "alternative" (ppAlt (Alt p t' rhs')) (ps `Set.union` ps')
   checkSkolems p "Alternative" ppAlt fs ps'' ty' (Alt p t' rhs')
 
-tcQual :: Position -> PredSet -> Statement a
+tcQual :: HasPosition p => p -> PredSet -> Statement a
        -> TCM (PredSet, Statement PredType)
-tcQual p ps (StmtExpr e) = do
+tcQual p ps (StmtExpr spi e) = do
   (ps', e') <- tcExpr p e >>- unify p "guard" (ppExpr 0 e) ps boolType
-  return (ps', StmtExpr e')
-tcQual _ ps (StmtDecl ds) = do
+  return (ps', StmtExpr spi e')
+tcQual _ ps (StmtDecl spi ds) = do
   (ps', ds') <- tcDecls ds
-  return (ps `Set.union` ps', StmtDecl ds')
-tcQual p ps q@(StmtBind t e) = do
+  return (ps `Set.union` ps', StmtDecl spi ds')
+tcQual p ps q@(StmtBind spi t e) = do
   alpha <- freshTypeVar
   (ps', e') <- tcArg p "generator" (ppStmt q) ps (listType alpha) e
   bindLambdaVars t
   (ps'', t') <- tcPatternArg p "generator" (ppStmt q) ps' alpha t
-  return (ps'', StmtBind t' e')
+  return (ps'', StmtBind spi t' e')
 
-tcStmt :: Position -> PredSet -> Maybe Type -> Statement a
+tcStmt :: HasPosition p => p -> PredSet -> Maybe Type -> Statement a
        -> TCM ((PredSet, Maybe Type), Statement PredType)
-tcStmt p ps mTy (StmtExpr e) = do
+tcStmt p ps mTy (StmtExpr spi e) = do
   (ps', ty) <- maybe freshMonadType (return . (,) emptyPredSet) mTy
   alpha <- freshTypeVar
   (ps'', e') <- tcExpr p e >>-
     unify p "statement" (ppExpr 0 e) (ps `Set.union` ps') (applyType ty [alpha])
-  return ((ps'', Just ty), StmtExpr e')
-tcStmt _ ps mTy (StmtDecl ds) = do
+  return ((ps'', Just ty), StmtExpr spi e')
+tcStmt _ ps mTy (StmtDecl spi ds) = do
   (ps', ds') <- tcDecls ds
-  return ((ps `Set.union` ps', mTy), StmtDecl ds')
-tcStmt p ps mTy st@(StmtBind t e) = do
+  return ((ps `Set.union` ps', mTy), StmtDecl spi ds')
+tcStmt p ps mTy st@(StmtBind spi t e) = do
   (ps', ty) <- maybe freshMonadType (return . (,) emptyPredSet) mTy
   alpha <- freshTypeVar
   (ps'', e') <-
     tcArg p "statement" (ppStmt st) (ps `Set.union` ps') (applyType ty [alpha]) e
   bindLambdaVars t
   (ps''', t') <- tcPatternArg p "statement" (ppStmt st) ps'' alpha t
-  return ((ps''', Just ty), StmtBind t' e')
+  return ((ps''', Just ty), StmtBind spi t' e')
 
 tcInfixOp :: InfixOp a -> TCM (PredSet, Type, InfixOp PredType)
 tcInfixOp (InfixOp _ op) = do
@@ -1294,14 +1302,14 @@
   vEnv <- getValueEnv
   (ps', TypeArrow ty1 ty2) <- inst (labelType m l vEnv)
   _ <- unify p "field label" empty emptyPredSet ty emptyPredSet ty1
-  (ps'', x') <- check p x >>-
+  (ps'', x') <- check (spanInfo2Pos p) x >>-
     unify p ("record " ++ what) (doc x) (ps `Set.union` ps') ty2
   return (ps'', Field p l x')
 
 -- The function 'tcArrow' checks that its argument can be used as
 -- an arrow type a -> b and returns the pair (a,b).
 
-tcArrow :: Position -> String -> Doc -> Type -> TCM (Type, Type)
+tcArrow :: HasPosition p => p -> String -> Doc -> Type -> TCM (Type, Type)
 tcArrow p what doc ty = do
   theta <- getTypeSubst
   unaryArrow (subst theta ty)
@@ -1320,7 +1328,7 @@
 -- The function 'tcBinary' checks that its argument can be used as an arrow type
 -- a -> b -> c and returns the triple (a,b,c).
 
-tcBinary :: Position -> String -> Doc -> Type -> TCM (Type, Type, Type)
+tcBinary :: HasPosition p => p -> String -> Doc -> Type -> TCM (Type, Type, Type)
 tcBinary p what doc ty = tcArrow p what doc ty >>= uncurry binaryArrow
   where
   binaryArrow ty1 (TypeArrow ty2 ty3) = return (ty1, ty2, ty3)
@@ -1336,7 +1344,7 @@
 
 -- Unification: The unification uses Robinson's algorithm.
 
-unify :: Position -> String -> Doc -> PredSet -> Type -> PredSet -> Type
+unify :: HasPosition p => p -> String -> Doc -> PredSet -> Type -> PredSet -> Type
       -> TCM PredSet
 unify p what doc ps1 ty1 ps2 ty2 = do
   theta <- getTypeSubst
@@ -1408,7 +1416,7 @@
 -- restricted by the current predicate set after the reduction and thus
 -- may cause a further extension of the current type substitution.
 
-reducePredSet :: Position -> String -> Doc -> PredSet -> TCM PredSet
+reducePredSet :: HasPosition p => p -> String -> Doc -> PredSet -> TCM PredSet
 reducePredSet p what doc ps = do
   m <- getModuleIdent
   clsEnv <- getClassEnv
@@ -1433,7 +1441,7 @@
       fmap (expandAliasType tys . snd3) (lookupInstInfo (qcls, tc) $ fst inEnv)
     _ -> Nothing
 
-reportMissingInstance :: ModuleIdent -> Position -> String -> Doc -> InstEnv'
+reportMissingInstance :: HasPosition p => ModuleIdent -> p -> String -> Doc -> InstEnv'
                       -> TypeSubst -> Pred -> TCM TypeSubst
 reportMissingInstance m p what doc inEnv theta (Pred qcls ty) =
   case subst theta ty of
@@ -1476,7 +1484,7 @@
 -- types that satisfies all constraints for the ambiguous type variable. An
 -- error is reported if no such type exists.
 
-applyDefaults :: Position -> String -> Doc -> Set.Set Int -> PredSet -> Type
+applyDefaults :: HasPosition p => p -> String -> Doc -> Set.Set Int -> PredSet -> Type
               -> TCM PredSet
 applyDefaults p what doc fvs ps ty = do
   m <- getModuleIdent
@@ -1521,7 +1529,7 @@
 -- a skolem constant escapes in the (result) type of 'f' and in the type of the
 -- environment variable 'x' for the fcase expression in the definition of 'g'.
 
-checkSkolems :: Position -> String -> (a -> Doc) -> Set.Set Int -> PredSet
+checkSkolems :: HasPosition p => p -> String -> (a -> Doc) -> Set.Set Int -> PredSet
              -> Type -> a -> TCM (PredSet, Type, a)
 checkSkolems p what pp fs ps ty x = do
   m <- getModuleIdent
@@ -1723,7 +1731,7 @@
 errPolymorphicVar v = posMessage v $ hsep $ map text
   ["Variable", idName v, "has a polymorphic type"]
 
-errTypeSigTooGeneral :: Position -> ModuleIdent -> Doc -> QualTypeExpr
+errTypeSigTooGeneral :: HasPosition a => a -> ModuleIdent -> Doc -> QualTypeExpr
                      -> TypeScheme -> Message
 errTypeSigTooGeneral p m what qty tySc = posMessage p $ vcat
   [ text "Type signature too general", what
@@ -1731,7 +1739,7 @@
   , text "Type signature:" <+> ppQualTypeExpr qty
   ]
 
-errMethodTypeTooSpecific :: Position -> ModuleIdent -> Doc -> PredType
+errMethodTypeTooSpecific :: HasPosition a => a -> ModuleIdent -> Doc -> PredType
                          -> TypeScheme -> Message
 errMethodTypeTooSpecific p m what pty tySc = posMessage p $ vcat
   [ text "Method type too specific", what
@@ -1739,7 +1747,7 @@
   , text "Expected type:" <+> ppPredType m pty
   ]
 
-errNonFunctionType :: Position -> String -> Doc -> ModuleIdent -> Type
+errNonFunctionType :: HasPosition a => a -> String -> Doc -> ModuleIdent -> Type
                    -> Message
 errNonFunctionType p what doc m ty = posMessage p $ vcat
   [ text "Type error in" <+> text what, doc
@@ -1747,14 +1755,14 @@
   , text "Cannot be applied"
   ]
 
-errNonBinaryOp :: Position -> String -> Doc -> ModuleIdent -> Type -> Message
+errNonBinaryOp :: HasPosition a => a -> String -> Doc -> ModuleIdent -> Type -> Message
 errNonBinaryOp p what doc m ty = posMessage p $ vcat
   [ text "Type error in" <+> text what, doc
   , text "Type:" <+> ppType m ty
   , text "Cannot be used as binary operator"
   ]
 
-errTypeMismatch :: Position -> String -> Doc -> ModuleIdent -> Type -> Type
+errTypeMismatch :: HasPosition a => a -> String -> Doc -> ModuleIdent -> Type -> Type
                 -> Doc -> Message
 errTypeMismatch p what doc m ty1 ty2 reason = posMessage p $ vcat
   [ text "Type error in"  <+> text what, doc
@@ -1763,11 +1771,11 @@
   , reason
   ]
 
-errSkolemFieldLabel :: Position -> Ident -> Message
+errSkolemFieldLabel :: HasPosition a => a -> Ident -> Message
 errSkolemFieldLabel p l = posMessage p $ hsep $ map text
   ["Existential type escapes with type of record selector", escName l]
 
-errSkolemEscapingScope :: Position -> ModuleIdent -> String -> Doc
+errSkolemEscapingScope :: HasPosition a => a -> ModuleIdent -> String -> Doc
                        -> (Doc, PredType) -> Message
 errSkolemEscapingScope p m what doc (whence, pty) = posMessage p $ vcat
   [ text "Existential type escapes out of its scope"
@@ -1785,7 +1793,7 @@
   , text "are incompatible"
   ]
 
-errIncompatibleLabelTypes :: Position -> ModuleIdent -> Ident -> Type -> Type
+errIncompatibleLabelTypes :: HasPosition a => a -> ModuleIdent -> Ident -> Type -> Type
                           -> Message
 errIncompatibleLabelTypes p m l ty1 ty2 = posMessage p $ sep
   [ text "Labeled types" <+> ppIdent l <+> text "::" <+> ppType m ty1
@@ -1793,7 +1801,7 @@
   , text "are incompatible"
   ]
 
-errMissingInstance :: ModuleIdent -> Position -> String -> Doc -> Pred
+errMissingInstance :: HasPosition a => ModuleIdent -> a -> String -> Doc -> Pred
                    -> Message
 errMissingInstance m p what doc pr = posMessage p $ vcat
   [ text "Missing instance for" <+> ppPred m pr
@@ -1801,7 +1809,7 @@
   , doc
   ]
 
-errAmbiguousTypeVariable :: ModuleIdent -> Position -> String -> Doc -> PredSet
+errAmbiguousTypeVariable :: HasPosition a => ModuleIdent -> a -> String -> Doc -> PredSet
                          -> Type -> Int -> Message
 errAmbiguousTypeVariable m p what doc ps ty tv = posMessage p $ vcat
   [ text "Ambiguous type variable" <+> ppType m (TypeVariable tv)
diff --git a/src/Checks/TypeSyntaxCheck.hs b/src/Checks/TypeSyntaxCheck.hs
--- a/src/Checks/TypeSyntaxCheck.hs
+++ b/src/Checks/TypeSyntaxCheck.hs
@@ -31,6 +31,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Pretty
 import Curry.Syntax
 import Curry.Syntax.Pretty
@@ -43,6 +44,8 @@
 import Env.TypeConstructor (TCEnv)
 import Env.Type
 
+-- TODO Use span info for err messages
+
 -- In order to check type constructor applications, the compiler
 -- maintains an environment containing all known type constructors and
 -- type classes. The function 'typeSyntaxCheck' expects a type constructor
@@ -54,7 +57,7 @@
 
 typeSyntaxCheck :: [KnownExtension] -> TCEnv -> Module a
                 -> ((Module a, [KnownExtension]), [Message])
-typeSyntaxCheck exts tcEnv mdl@(Module _ m _ _ ds) =
+typeSyntaxCheck exts tcEnv mdl@(Module _ _ m _ _ ds) =
   case findMultiples $ map getIdent tcds of
     [] -> if length dfds <= 1
             then runTSCM (checkModule mdl) state
@@ -63,7 +66,7 @@
   where
     tcds = filter isTypeOrClassDecl ds
     dfds = filter isDefaultDecl ds
-    dfps = map (\(DefaultDecl p _) -> p) dfds
+    dfps = map (\(DefaultDecl p _) -> spanInfo2Pos p) dfds
     tEnv = foldr (bindType m) (fmap toTypeKind tcEnv) tcds
     state = TSCState m tEnv exts Map.empty 1 []
 
@@ -221,71 +224,72 @@
   rename (NewRecordDecl p c (l, ty)) = NewRecordDecl p c . (,) l <$> rename ty
 
 instance Rename Constraint where
-  rename (Constraint cls ty) = Constraint cls <$> rename ty
+  rename (Constraint spi cls ty) = Constraint spi cls <$> rename ty
 
 instance Rename QualTypeExpr where
-  rename (QualTypeExpr cx ty) = QualTypeExpr <$> rename cx <*> rename ty
+  rename (QualTypeExpr spi cx ty) = QualTypeExpr spi <$> rename cx <*> rename ty
 
 instance Rename TypeExpr where
-  rename (ConstructorType tc) = return $ ConstructorType tc
-  rename (ApplyType ty1 ty2) = ApplyType <$> rename ty1 <*> rename ty2
-  rename (VariableType tv) = VariableType <$> rename tv
-  rename (TupleType tys) = TupleType <$> rename tys
-  rename (ListType ty) = ListType <$> rename ty
-  rename (ArrowType ty1 ty2) = ArrowType <$> rename ty1 <*> rename ty2
-  rename (ParenType ty) = ParenType <$> rename ty
-  rename (ForallType vs ty) = do
+  rename (ConstructorType spi tc) = return $ ConstructorType spi tc
+  rename (ApplyType spi ty1 ty2) = ApplyType spi <$> rename ty1 <*> rename ty2
+  rename (VariableType spi tv) = VariableType spi <$> rename tv
+  rename (TupleType spi tys) = TupleType spi <$> rename tys
+  rename (ListType spi ty) = ListType spi <$> rename ty
+  rename (ArrowType spi ty1 ty2) = ArrowType spi <$> rename ty1 <*> rename ty2
+  rename (ParenType spi ty) = ParenType spi <$> rename ty
+  rename (ForallType spi vs ty) = do
     bindVars vs
-    ForallType <$> mapM rename vs <*> rename ty
+    ForallType spi <$> mapM rename vs <*> rename ty
 
 instance Rename (Equation a) where
   rename (Equation p lhs rhs) = Equation p lhs <$> rename rhs
 
 instance Rename (Rhs a) where
-  rename (SimpleRhs p e ds) = SimpleRhs p <$> rename e <*> rename ds
-  rename (GuardedRhs es ds) = GuardedRhs <$> rename es <*> rename ds
+  rename (SimpleRhs  spi e  ds) = SimpleRhs  spi <$> rename e  <*> rename ds
+  rename (GuardedRhs spi es ds) = GuardedRhs spi <$> rename es <*> rename ds
 
 instance Rename (CondExpr a) where
-  rename (CondExpr p c e) = CondExpr p <$> rename c <*> rename e
+  rename (CondExpr spi c e) = CondExpr spi <$> rename c <*> rename e
 
 instance Rename (Expression a) where
-  rename (Literal a l) = return $ Literal a l
-  rename (Variable a v) = return $ Variable a v
-  rename (Constructor a c) = return $ Constructor a c
-  rename (Paren e) = Paren <$> rename e
-  rename (Typed e qty) = Typed <$> rename e <*> renameTypeSig qty
-  rename (Record a c fs) = Record a c <$> rename fs
-  rename (RecordUpdate e fs) = RecordUpdate <$> rename e <*> rename fs
-  rename (Tuple es) = Tuple <$> rename es
-  rename (List a es) = List a <$> rename es
-  rename (ListCompr e stmts) = ListCompr <$> rename e <*> rename stmts
-  rename (EnumFrom e) = EnumFrom <$> rename e
-  rename (EnumFromThen e1 e2) = EnumFromThen <$> rename e1 <*> rename e2
-  rename (EnumFromTo e1 e2) = EnumFromTo <$> rename e1 <*> rename e2
-  rename (EnumFromThenTo e1 e2 e3) =
-    EnumFromThenTo <$> rename e1 <*> rename e2 <*> rename e3
-  rename (UnaryMinus e) = UnaryMinus <$> rename e
-  rename (Apply e1 e2) = Apply <$> rename e1 <*> rename e2
-  rename (InfixApply e1 op e2) = flip InfixApply op <$> rename e1 <*> rename e2
-  rename (LeftSection e op) = flip LeftSection op <$> rename e
-  rename (RightSection op e) = RightSection op <$> rename e
-  rename (Lambda ts e) = Lambda ts <$> rename e
-  rename (Let ds e) = Let <$> rename ds <*> rename e
-  rename (Do stmts e) = Do <$> rename stmts <*> rename e
-  rename (IfThenElse c e1 e2) =
-    IfThenElse <$> rename c <*> rename e1 <*> rename e2
-  rename (Case ct e alts) = Case ct <$> rename e <*> rename alts
+  rename (Literal spi a l) = return $ Literal spi a l
+  rename (Variable spi a v) = return $ Variable spi a v
+  rename (Constructor spi a c) = return $ Constructor spi a c
+  rename (Paren spi e) = Paren spi <$> rename e
+  rename (Typed spi e qty) = Typed spi <$> rename e <*> renameTypeSig qty
+  rename (Record spi a c fs) = Record spi a c <$> rename fs
+  rename (RecordUpdate spi e fs) = RecordUpdate spi <$> rename e <*> rename fs
+  rename (Tuple spi es) = Tuple spi <$> rename es
+  rename (List spi a es) = List spi a <$> rename es
+  rename (ListCompr spi e stmts) = ListCompr spi <$> rename e <*> rename stmts
+  rename (EnumFrom spi e) = EnumFrom spi <$> rename e
+  rename (EnumFromThen spi e1 e2) = EnumFromThen spi <$> rename e1 <*> rename e2
+  rename (EnumFromTo spi e1 e2) = EnumFromTo spi <$> rename e1 <*> rename e2
+  rename (EnumFromThenTo spi e1 e2 e3) =
+    EnumFromThenTo spi <$> rename e1 <*> rename e2 <*> rename e3
+  rename (UnaryMinus spi e) = UnaryMinus spi <$> rename e
+  rename (Apply spi e1 e2) = Apply spi <$> rename e1 <*> rename e2
+  rename (InfixApply spi e1 op e2) =
+    flip (InfixApply spi) op <$> rename e1 <*> rename e2
+  rename (LeftSection spi e op) = flip (LeftSection spi) op <$> rename e
+  rename (RightSection spi op e) = RightSection spi op <$> rename e
+  rename (Lambda spi ts e) = Lambda spi ts <$> rename e
+  rename (Let spi ds e) = Let spi <$> rename ds <*> rename e
+  rename (Do spi stmts e) = Do spi <$> rename stmts <*> rename e
+  rename (IfThenElse spi c e1 e2) =
+    IfThenElse spi <$> rename c <*> rename e1 <*> rename e2
+  rename (Case spi ct e alts) = Case spi ct <$> rename e <*> rename alts
 
 instance Rename (Statement a) where
-  rename (StmtExpr e) = StmtExpr <$> rename e
-  rename (StmtDecl ds) = StmtDecl <$> rename ds
-  rename (StmtBind t e) = StmtBind t <$> rename e
+  rename (StmtExpr spi e) = StmtExpr spi <$> rename e
+  rename (StmtDecl spi ds) = StmtDecl spi <$> rename ds
+  rename (StmtBind spi t e) = StmtBind spi t <$> rename e
 
 instance Rename (Alt a) where
-  rename (Alt p t rhs) = Alt p t <$> rename rhs
+  rename (Alt spi t rhs) = Alt spi t <$> rename rhs
 
 instance Rename a => Rename (Field a) where
-  rename (Field p l x) = Field p l <$> rename x
+  rename (Field spi l x) = Field spi l <$> rename x
 
 instance Rename Ident where
   rename tv | isAnonId tv = renameIdent tv <$> newId
@@ -310,11 +314,11 @@
 -- traversed because they can contain local type signatures.
 
 checkModule :: Module a -> TSCM (Module a, [KnownExtension])
-checkModule (Module ps m es is ds) = do
+checkModule (Module spi ps m es is ds) = do
   ds' <- mapM checkDecl ds
   ds'' <- rename ds'
   exts <- getExtensions
-  return (Module ps m es is ds'', exts)
+  return (Module spi ps m es is ds'', exts)
 
 checkDecl :: Decl a -> TSCM (Decl a)
 checkDecl (DataDecl p tc tvs cs clss) = do
@@ -347,7 +351,7 @@
   return $ ClassDecl p cx' cls clsvar ds'
 checkDecl (InstanceDecl p cx qcls inst ds) = do
   checkClass qcls
-  QualTypeExpr cx' inst' <- checkQualType $ QualTypeExpr cx inst
+  QualTypeExpr _ cx' inst' <- checkQualType $ QualTypeExpr NoSpanInfo cx inst
   checkSimpleContext cx'
   checkInstanceType p inst'
   InstanceDecl p cx' qcls inst' <$> mapM checkDecl ds
@@ -386,7 +390,7 @@
 checkSimpleContext = mapM_ checkSimpleConstraint
 
 checkSimpleConstraint :: Constraint -> TSCM ()
-checkSimpleConstraint c@(Constraint _ ty) =
+checkSimpleConstraint c@(Constraint _ _ ty) =
   unless (isVariableType ty) $ report $ errIllegalSimpleConstraint c
 
 -- Class method's type signatures have to obey a few additional restrictions.
@@ -394,27 +398,28 @@
 -- context must not contain any additional constraints for that class variable.
 
 checkClassMethod :: Ident -> Decl a -> TSCM ()
-checkClassMethod tv (TypeSig p _ qty) = do
+checkClassMethod tv (TypeSig spi _ qty) = do
   unless (tv `elem` fv qty) $ report $ errAmbiguousType p tv
-  let QualTypeExpr cx _ = qty
+  let QualTypeExpr _ cx _ = qty
   when (tv `elem` fv cx) $ report $ errConstrainedClassVariable p tv
+  where p = spanInfo2Pos spi
 checkClassMethod _ _ = ok
 
-checkInstanceType :: Position -> InstanceType -> TSCM ()
+checkInstanceType :: SpanInfo -> InstanceType -> TSCM ()
 checkInstanceType p inst = do
   tEnv <- getTypeEnv
   unless (isSimpleType inst &&
     not (isTypeSyn (typeConstr inst) tEnv) &&
-    null (filter isAnonId $ typeVariables inst) &&
+    not (any isAnonId $ typeVariables inst) &&
     isNothing (findDouble $ fv inst)) $
-      report $ errIllegalInstanceType p inst
+      report $ errIllegalInstanceType (spanInfo2Pos p) inst
 
 checkTypeLhs :: [Ident] -> TSCM ()
 checkTypeLhs = checkTypeVars "left hand side of type declaration"
 
 checkExistVars :: [Ident] -> TSCM ()
 checkExistVars evs = do
-  unless (null evs) $ checkUsedExtension (idPosition $ head evs)
+  unless (null evs) $ checkUsedExtension (getPosition $ head evs)
     "Existentially quantified types" ExistentialQuantification
   checkTypeVars "list of existentially quantified type variables" evs
 
@@ -439,61 +444,67 @@
 checkEquation (Equation p lhs rhs) = Equation p lhs <$> checkRhs rhs
 
 checkRhs :: Rhs a -> TSCM (Rhs a)
-checkRhs (SimpleRhs p e ds) = SimpleRhs p <$> checkExpr e <*> mapM checkDecl ds
-checkRhs (GuardedRhs es ds) = GuardedRhs  <$> mapM checkCondExpr es
-                                          <*> mapM checkDecl ds
+checkRhs (SimpleRhs  spi e  ds) = SimpleRhs  spi <$> checkExpr e
+                                                 <*> mapM checkDecl ds
+checkRhs (GuardedRhs spi es ds) = GuardedRhs spi <$> mapM checkCondExpr es
+                                                 <*> mapM checkDecl ds
 
 checkCondExpr :: CondExpr a -> TSCM (CondExpr a)
-checkCondExpr (CondExpr p g e) = CondExpr p <$> checkExpr g <*> checkExpr e
+checkCondExpr (CondExpr spi g e) = CondExpr spi <$> checkExpr g <*> checkExpr e
 
 checkExpr :: Expression a -> TSCM (Expression a)
-checkExpr l@(Literal           _ _) = return l
-checkExpr v@(Variable          _ _) = return v
-checkExpr c@(Constructor       _ _) = return c
-checkExpr (Paren                 e) = Paren <$> checkExpr e
-checkExpr (Typed             e qty) = Typed <$> checkExpr e
-                                            <*> checkQualType qty
-checkExpr (Record           a c fs) = Record a c <$> mapM checkFieldExpr fs
-checkExpr (RecordUpdate       e fs) = RecordUpdate <$> checkExpr e
-                                                   <*> mapM checkFieldExpr fs
-checkExpr (Tuple                es) = Tuple <$> mapM checkExpr es
-checkExpr (List               a es) = List a <$> mapM checkExpr es
-checkExpr (ListCompr          e qs) = ListCompr <$> checkExpr e
-                                                <*> mapM checkStmt qs
-checkExpr (EnumFrom              e) = EnumFrom <$> checkExpr e
-checkExpr (EnumFromThen      e1 e2) = EnumFromThen <$> checkExpr e1
-                                                   <*> checkExpr e2
-checkExpr (EnumFromTo        e1 e2) = EnumFromTo <$> checkExpr e1
-                                                 <*> checkExpr e2
-checkExpr (EnumFromThenTo e1 e2 e3) = EnumFromThenTo <$> checkExpr e1
-                                                     <*> checkExpr e2
-                                                     <*> checkExpr e3
-checkExpr (UnaryMinus            e) = UnaryMinus <$> checkExpr e
-checkExpr (Apply             e1 e2) = Apply <$> checkExpr e1 <*> checkExpr e2
-checkExpr (InfixApply     e1 op e2) = InfixApply <$> checkExpr e1
-                                                 <*> return op
-                                                 <*> checkExpr e2
-checkExpr (LeftSection        e op) = flip LeftSection op <$> checkExpr e
-checkExpr (RightSection       op e) = RightSection op <$> checkExpr e
-checkExpr (Lambda             ts e) = Lambda ts <$> checkExpr e
-checkExpr (Let                ds e) = Let <$> mapM checkDecl ds <*> checkExpr e
-checkExpr (Do                sts e) = Do <$> mapM checkStmt sts <*> checkExpr e
-checkExpr (IfThenElse     e1 e2 e3) = IfThenElse <$> checkExpr e1
-                                                 <*> checkExpr e2
-                                                 <*> checkExpr e3
-checkExpr (Case          ct e alts) = Case ct <$> checkExpr e
-                                              <*> mapM checkAlt alts
+checkExpr l@(Literal             _ _ _) = return l
+checkExpr v@(Variable            _ _ _) = return v
+checkExpr c@(Constructor         _ _ _) = return c
+checkExpr (Paren                 spi e) = Paren spi <$> checkExpr e
+checkExpr (Typed             spi e qty) = Typed spi <$> checkExpr e
+                                                    <*> checkQualType qty
+checkExpr (Record           spi a c fs) =
+  Record spi a c <$> mapM checkFieldExpr fs
+checkExpr (RecordUpdate       spi e fs) =
+  RecordUpdate spi <$> checkExpr e <*> mapM checkFieldExpr fs
+checkExpr (Tuple                spi es) = Tuple spi <$> mapM checkExpr es
+checkExpr (List               spi a es) = List spi a <$> mapM checkExpr es
+checkExpr (ListCompr          spi e qs) = ListCompr spi <$> checkExpr e
+                                                        <*> mapM checkStmt qs
+checkExpr (EnumFrom              spi e) = EnumFrom spi <$> checkExpr e
+checkExpr (EnumFromThen      spi e1 e2) = EnumFromThen spi <$> checkExpr e1
+                                                           <*> checkExpr e2
+checkExpr (EnumFromTo        spi e1 e2) = EnumFromTo spi <$> checkExpr e1
+                                                         <*> checkExpr e2
+checkExpr (EnumFromThenTo spi e1 e2 e3) = EnumFromThenTo spi <$> checkExpr e1
+                                                             <*> checkExpr e2
+                                                             <*> checkExpr e3
+checkExpr (UnaryMinus            spi e) = UnaryMinus spi <$> checkExpr e
+checkExpr (Apply             spi e1 e2) = Apply spi <$> checkExpr e1
+                                                    <*> checkExpr e2
+checkExpr (InfixApply     spi e1 op e2) = InfixApply spi <$> checkExpr e1
+                                                         <*> return op
+                                                         <*> checkExpr e2
+checkExpr (LeftSection        spi e op) =
+  flip (LeftSection spi) op <$> checkExpr e
+checkExpr (RightSection       spi op e) = RightSection spi op <$> checkExpr e
+checkExpr (Lambda             spi ts e) = Lambda spi ts <$> checkExpr e
+checkExpr (Let                spi ds e) = Let spi <$> mapM checkDecl ds
+                                                  <*> checkExpr e
+checkExpr (Do                spi sts e) = Do spi <$> mapM checkStmt sts
+                                                 <*> checkExpr e
+checkExpr (IfThenElse     spi e1 e2 e3) = IfThenElse spi <$> checkExpr e1
+                                                         <*> checkExpr e2
+                                                         <*> checkExpr e3
+checkExpr (Case          spi ct e alts) = Case spi ct <$> checkExpr e
+                                                      <*> mapM checkAlt alts
 
 checkStmt :: Statement a -> TSCM (Statement a)
-checkStmt (StmtExpr   e) = StmtExpr <$> checkExpr e
-checkStmt (StmtBind t e) = StmtBind t <$> checkExpr e
-checkStmt (StmtDecl  ds) = StmtDecl <$> mapM checkDecl ds
+checkStmt (StmtExpr spi   e) = StmtExpr spi   <$> checkExpr e
+checkStmt (StmtBind spi t e) = StmtBind spi t <$> checkExpr e
+checkStmt (StmtDecl spi  ds) = StmtDecl spi   <$> mapM checkDecl ds
 
 checkAlt :: Alt a -> TSCM (Alt a)
-checkAlt (Alt p t rhs) = Alt p t <$> checkRhs rhs
+checkAlt (Alt spi t rhs) = Alt spi t <$> checkRhs rhs
 
 checkFieldExpr :: Field (Expression a) -> TSCM (Field (Expression a))
-checkFieldExpr (Field p l e) = Field p l <$> checkExpr e
+checkFieldExpr (Field spi l e) = Field spi l <$> checkExpr e
 
 -- The parser cannot distinguish unqualified nullary type constructors
 -- and type variables. Therefore, if the compiler finds an unbound
@@ -501,29 +512,29 @@
 -- interpret the identifier as such.
 
 checkQualType :: QualTypeExpr -> TSCM QualTypeExpr
-checkQualType (QualTypeExpr cx ty) = do
+checkQualType (QualTypeExpr spi cx ty) = do
   ty' <- checkType ty
   cx' <- checkClosedContext (fv ty') cx
-  return $ QualTypeExpr cx' ty'
+  return $ QualTypeExpr spi cx' ty'
 
 checkClosedContext :: [Ident] -> Context -> TSCM Context
 checkClosedContext tvs cx = do
   cx' <- checkContext cx
-  mapM_ (\(Constraint _ ty) -> checkClosed tvs ty) cx'
+  mapM_ (\(Constraint _ _ ty) -> checkClosed tvs ty) cx'
   return cx'
 
 checkContext :: Context -> TSCM Context
 checkContext = mapM checkConstraint
 
 checkConstraint :: Constraint -> TSCM Constraint
-checkConstraint c@(Constraint qcls ty) = do
+checkConstraint c@(Constraint spi qcls ty) = do
   checkClass qcls
   ty' <- checkType ty
   unless (isVariableType $ rootType ty') $ report $ errIllegalConstraint c
-  return $ Constraint qcls ty'
+  return $ Constraint spi qcls ty'
   where
-    rootType (ApplyType ty' _) = ty'
-    rootType ty'               = ty'
+    rootType (ApplyType _ ty' _) = ty'
+    rootType ty'                 = ty'
 
 checkClass :: QualIdent -> TSCM ()
 checkClass qcls = do
@@ -545,13 +556,13 @@
   return ty'
 
 checkType :: TypeExpr -> TSCM TypeExpr
-checkType c@(ConstructorType tc) = do
+checkType c@(ConstructorType spi tc) = do
   m <- getModuleIdent
   tEnv <- getTypeEnv
   case qualLookupTypeKind tc tEnv of
     []
       | isQTupleId tc -> return c
-      | not (isQualified tc) -> return $ VariableType $ unqualify tc
+      | not (isQualified tc) -> return $ VariableType spi $ unqualify tc
       | otherwise -> report (errUndefinedType tc) >> return c
     [Class _ _] -> report (errUndefinedType tc) >> return c
     [_] -> return c
@@ -559,26 +570,28 @@
       [Class _ _] -> report (errUndefinedType tc) >> return c
       [_] -> return c
       _ -> report (errAmbiguousIdent tc $ map origName tks) >> return c
-checkType (ApplyType ty1 ty2) = ApplyType  <$> checkType ty1 <*> checkType ty2
-checkType v@(VariableType tv)
+checkType (ApplyType spi ty1 ty2) = ApplyType spi <$> checkType ty1
+                                                  <*> checkType ty2
+checkType v@(VariableType spi tv)
   | isAnonId tv = return v
-  | otherwise   = checkType $ ConstructorType (qualify tv)
-checkType (TupleType     tys) = TupleType  <$> mapM checkType tys
-checkType (ListType       ty) = ListType   <$> checkType ty
-checkType (ArrowType ty1 ty2) = ArrowType  <$> checkType ty1 <*> checkType ty2
-checkType (ParenType      ty) = ParenType  <$> checkType ty
-checkType (ForallType  vs ty) = ForallType vs <$> checkType ty
+  | otherwise   = checkType $ ConstructorType  spi (qualify tv)
+checkType (TupleType     spi tys) = TupleType  spi    <$> mapM checkType tys
+checkType (ListType       spi ty) = ListType   spi    <$> checkType ty
+checkType (ArrowType spi ty1 ty2) = ArrowType  spi    <$> checkType ty1
+                                                      <*> checkType ty2
+checkType (ParenType      spi ty) = ParenType  spi    <$> checkType ty
+checkType (ForallType  spi vs ty) = ForallType spi vs <$> checkType ty
 
 checkClosed :: [Ident] -> TypeExpr -> TSCM ()
-checkClosed _   (ConstructorType _) = ok
-checkClosed tvs (ApplyType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
-checkClosed tvs (VariableType   tv) =
+checkClosed _   (ConstructorType _ _) = ok
+checkClosed tvs (ApplyType _ ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
+checkClosed tvs (VariableType   _ tv) =
   when (isAnonId tv || tv `notElem` tvs) $ report $ errUnboundVariable tv
-checkClosed tvs (TupleType     tys) = mapM_ (checkClosed tvs) tys
-checkClosed tvs (ListType       ty) = checkClosed tvs ty
-checkClosed tvs (ArrowType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
-checkClosed tvs (ParenType      ty) = checkClosed tvs ty
-checkClosed tvs (ForallType  vs ty) = checkClosed (tvs ++ vs) ty
+checkClosed tvs (TupleType     _ tys) = mapM_ (checkClosed tvs) tys
+checkClosed tvs (ListType       _ ty) = checkClosed tvs ty
+checkClosed tvs (ArrowType _ ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
+checkClosed tvs (ParenType      _ ty) = checkClosed tvs ty
+checkClosed tvs (ForallType  _ vs ty) = checkClosed (tvs ++ vs) ty
 
 checkUsedExtension :: Position -> String -> KnownExtension -> TSCM ()
 checkUsedExtension pos msg ext = do
@@ -620,7 +633,7 @@
   text "Multiple declarations of" <+> text (escName i) <+> text "at:" $+$
     nest 2 (vcat $ map showPos is)
   where i = head is
-        showPos = text . showLine . idPosition
+        showPos = text . showLine . getPosition
 
 errMissingLanguageExtension :: Position -> String -> KnownExtension -> Message
 errMissingLanguageExtension p what ext = posMessage p $
@@ -664,14 +677,14 @@
   [ "Unbound type variable", idName tv ]
 
 errIllegalConstraint :: Constraint -> Message
-errIllegalConstraint c@(Constraint qcls _) = posMessage qcls $ vcat
+errIllegalConstraint c@(Constraint _ qcls _) = posMessage qcls $ vcat
   [ text "Illegal class constraint" <+> ppConstraint c
   , text "Constraints must be of the form C u or C (u t1 ... tn),"
   , text "where C is a type class, u is a type variable and t1, ..., tn are types."
   ]
 
 errIllegalSimpleConstraint :: Constraint -> Message
-errIllegalSimpleConstraint c@(Constraint qcls _) = posMessage qcls $ vcat
+errIllegalSimpleConstraint c@(Constraint _ qcls _) = posMessage qcls $ vcat
   [ text "Illegal class constraint" <+> ppConstraint c
   , text "Constraints in class and instance declarations must be of"
   , text "the form C u, where C is a type class and u is a type variable."
diff --git a/src/Checks/WarnCheck.hs b/src/Checks/WarnCheck.hs
--- a/src/Checks/WarnCheck.hs
+++ b/src/Checks/WarnCheck.hs
@@ -14,8 +14,13 @@
     This module searches for potentially irregular code and generates
     warning messages.
 -}
+{-# LANGUAGE CPP #-}
 module Checks.WarnCheck (warnCheck) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 import           Control.Monad
   (filterM, foldM_, guard, liftM, liftM2, when, unless)
 import           Control.Monad.State.Strict    (State, execState, gets, modify)
@@ -32,6 +37,7 @@
 import Curry.Base.Ident
 import Curry.Base.Position
 import Curry.Base.Pretty
+import Curry.Base.SpanInfo
 import Curry.Syntax
 import Curry.Syntax.Pretty (ppDecl, ppPattern, ppExpr, ppIdent)
 
@@ -70,7 +76,7 @@
       checkMissingTypeSignatures ds
       checkModuleAlias is
       checkCaseMode  ds
-  where Module _ mid es is ds = fmap (const ()) mdl
+  where Module _ _ mid es is ds = fmap (const ()) mdl
 
 type ScopeEnv = NestEnv IdInfo
 
@@ -136,8 +142,8 @@
   mapM_ visitExport exports
   reportUnusedGlobalVars
     where
-      visitExport (Export qid) = visitQId qid
-      visitExport _            = ok
+      visitExport (Export _ qid) = visitQId qid
+      visitExport _              = ok
 
 -- ---------------------------------------------------------------------------
 -- checkImports
@@ -181,13 +187,13 @@
 
   setImportSpec env mid ishs = return $ Map.insert mid ishs env
 
-  cmpImport (ImportTypeWith id1 cs1) (ImportTypeWith id2 cs2)
+  cmpImport (ImportTypeWith _ id1 cs1) (ImportTypeWith _ id2 cs2)
     = id1 == id2 && null (intersect cs1 cs2)
   cmpImport i1 i2 = (impName i1) == (impName i2)
 
-  impName (Import           v) = v
-  impName (ImportTypeAll    t) = t
-  impName (ImportTypeWith t _) = t
+  impName (Import           _ v) = v
+  impName (ImportTypeAll    _ t) = t
+  impName (ImportTypeWith _ t _) = t
 
 warnMultiplyImportedModule :: ModuleIdent -> Message
 warnMultiplyImportedModule mid = posMessage mid $ hsep $ map text
@@ -233,7 +239,7 @@
       else case Map.lookup f env of
         Nothing -> return (f, Map.insert f p env)
         Just p' -> do
-          report $ warnDisjoinedFunctionRules f p'
+          report $ warnDisjoinedFunctionRules f (spanInfo2Pos p')
           return (f, env)
   check (_    , env) _                     = return (mkIdent "", env)
 
@@ -297,14 +303,14 @@
   checkTypeExpr ty
 
 checkTypeExpr :: TypeExpr -> WCM ()
-checkTypeExpr (ConstructorType     qid) = visitQTypeId qid
-checkTypeExpr (ApplyType       ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2]
-checkTypeExpr (VariableType          v) = visitTypeId v
-checkTypeExpr (TupleType           tys) = mapM_ checkTypeExpr tys
-checkTypeExpr (ListType             ty) = checkTypeExpr ty
-checkTypeExpr (ArrowType       ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2]
-checkTypeExpr (ParenType            ty) = checkTypeExpr ty
-checkTypeExpr (ForallType        vs ty) = do
+checkTypeExpr (ConstructorType     _ qid) = visitQTypeId qid
+checkTypeExpr (ApplyType       _ ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2]
+checkTypeExpr (VariableType          _ v) = visitTypeId v
+checkTypeExpr (TupleType           _ tys) = mapM_ checkTypeExpr tys
+checkTypeExpr (ListType             _ ty) = checkTypeExpr ty
+checkTypeExpr (ArrowType       _ ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2]
+checkTypeExpr (ParenType            _ ty) = checkTypeExpr ty
+checkTypeExpr (ForallType        _ vs ty) = do
   mapM_ insertTypeVar vs
   checkTypeExpr ty
 
@@ -316,20 +322,21 @@
 checkLocalDecl (PatternDecl    _ p _) = checkPattern p
 checkLocalDecl _                      = ok
 
-checkFunctionDecl :: Position -> Ident -> [Equation ()] -> WCM ()
+checkFunctionDecl :: SpanInfo -> Ident -> [Equation ()] -> WCM ()
 checkFunctionDecl _ _ []  = ok
 checkFunctionDecl p f eqs = inNestedScope $ do
   mapM_ checkEquation eqs
   checkFunctionPatternMatch p f eqs
 
-checkFunctionPatternMatch :: Position -> Ident -> [Equation ()] -> WCM ()
-checkFunctionPatternMatch p f eqs = do
+checkFunctionPatternMatch :: SpanInfo -> Ident -> [Equation ()] -> WCM ()
+checkFunctionPatternMatch spi f eqs = do
   let pats = map (\(Equation _ lhs _) -> snd (flatLhs lhs)) eqs
   (nonExhaustive, overlapped, nondet) <- checkPatternMatching pats
   unless (null nonExhaustive) $ warnFor WarnIncompletePatterns $ report $
     warnMissingPattern p ("an equation for " ++ escName f) nonExhaustive
   when (nondet || not (null overlapped)) $ warnFor WarnOverlapping $ report $
     warnNondetOverlapping p ("Function " ++ escName f)
+  where p = spanInfo2Pos spi
 
 -- Check an equation for warnings.
 -- This is done in a seperate scope as the left-hand-side may introduce
@@ -341,29 +348,29 @@
   reportUnusedVars
 
 checkLhs :: Lhs a -> WCM ()
-checkLhs (FunLhs    _ ts) = do
+checkLhs (FunLhs    _ _ ts) = do
   mapM_ checkPattern ts
   mapM_ (insertPattern False) ts
-checkLhs (OpLhs t1 op t2) = checkLhs (FunLhs op [t1, t2])
-checkLhs (ApLhs   lhs ts) = do
+checkLhs (OpLhs spi t1 op t2) = checkLhs (FunLhs spi op [t1, t2])
+checkLhs (ApLhs   _ lhs ts) = do
   checkLhs lhs
   mapM_ checkPattern ts
   mapM_ (insertPattern False) ts
 
 checkPattern :: Pattern a -> WCM ()
-checkPattern (VariablePattern        _ v) = checkShadowing v
-checkPattern (ConstructorPattern  _ _ ps) = mapM_ checkPattern ps
-checkPattern (InfixPattern     a p1 f p2) = checkPattern
-                                            (ConstructorPattern a f [p1, p2])
-checkPattern (ParenPattern             p) = checkPattern p
-checkPattern (RecordPattern       _ _ fs) = mapM_ (checkField checkPattern) fs
-checkPattern (TuplePattern            ps) = mapM_ checkPattern ps
-checkPattern (ListPattern           _ ps) = mapM_ checkPattern ps
-checkPattern (AsPattern              v p) = checkShadowing v >> checkPattern p
-checkPattern (LazyPattern              p) = checkPattern p
-checkPattern (FunctionPattern     _ _ ps) = mapM_ checkPattern ps
-checkPattern (InfixFuncPattern a p1 f p2) = checkPattern
-                                            (FunctionPattern a f [p1, p2])
+checkPattern (VariablePattern          _ _ v) = checkShadowing v
+checkPattern (ConstructorPattern    _ _ _ ps) = mapM_ checkPattern ps
+checkPattern (InfixPattern     spi a p1 f p2) =
+  checkPattern (ConstructorPattern spi a f [p1, p2])
+checkPattern (ParenPattern               _ p) = checkPattern p
+checkPattern (RecordPattern         _ _ _ fs) = mapM_ (checkField checkPattern) fs
+checkPattern (TuplePattern              _ ps) = mapM_ checkPattern ps
+checkPattern (ListPattern             _ _ ps) = mapM_ checkPattern ps
+checkPattern (AsPattern                _ v p) = checkShadowing v >> checkPattern p
+checkPattern (LazyPattern                _ p) = checkPattern p
+checkPattern (FunctionPattern       _ _ _ ps) = mapM_ checkPattern ps
+checkPattern (InfixFuncPattern spi a p1 f p2) =
+  checkPattern (FunctionPattern spi a f [p1, p2])
 checkPattern _                            = ok
 
 -- Check the right-hand-side of an equation.
@@ -374,7 +381,7 @@
   checkLocalDeclGroup ds
   checkExpr e
   reportUnusedVars
-checkRhs (GuardedRhs ce ds) = inNestedScope $ do
+checkRhs (GuardedRhs _ ce ds) = inNestedScope $ do
   checkLocalDeclGroup ds
   mapM_ checkCondExpr ce
   reportUnusedVars
@@ -383,39 +390,39 @@
 checkCondExpr (CondExpr _ c e) = checkExpr c >> checkExpr e
 
 checkExpr :: Expression () -> WCM ()
-checkExpr (Variable            _ v) = visitQId v
-checkExpr (Paren                 e) = checkExpr e
-checkExpr (Typed               e _) = checkExpr e
-checkExpr (Record           _ _ fs) = mapM_ (checkField checkExpr) fs
-checkExpr (RecordUpdate       e fs) = do
+checkExpr (Variable            _ _ v) = visitQId v
+checkExpr (Paren                 _ e) = checkExpr e
+checkExpr (Typed               _ e _) = checkExpr e
+checkExpr (Record           _ _ _ fs) = mapM_ (checkField checkExpr) fs
+checkExpr (RecordUpdate       _ e fs) = do
   checkExpr e
   mapM_ (checkField checkExpr) fs
-checkExpr (Tuple                es) = mapM_ checkExpr es
-checkExpr (List               _ es) = mapM_ checkExpr es
-checkExpr (ListCompr         e sts) = checkStatements sts e
-checkExpr (EnumFrom              e) = checkExpr e
-checkExpr (EnumFromThen      e1 e2) = mapM_ checkExpr [e1, e2]
-checkExpr (EnumFromTo        e1 e2) = mapM_ checkExpr [e1, e2]
-checkExpr (EnumFromThenTo e1 e2 e3) = mapM_ checkExpr [e1, e2, e3]
-checkExpr (UnaryMinus            e) = checkExpr e
-checkExpr (Apply             e1 e2) = mapM_ checkExpr [e1, e2]
-checkExpr (InfixApply     e1 op e2) = do
+checkExpr (Tuple                _ es) = mapM_ checkExpr es
+checkExpr (List               _ _ es) = mapM_ checkExpr es
+checkExpr (ListCompr         _ e sts) = checkStatements sts e
+checkExpr (EnumFrom              _ e) = checkExpr e
+checkExpr (EnumFromThen      _ e1 e2) = mapM_ checkExpr [e1, e2]
+checkExpr (EnumFromTo        _ e1 e2) = mapM_ checkExpr [e1, e2]
+checkExpr (EnumFromThenTo _ e1 e2 e3) = mapM_ checkExpr [e1, e2, e3]
+checkExpr (UnaryMinus            _ e) = checkExpr e
+checkExpr (Apply             _ e1 e2) = mapM_ checkExpr [e1, e2]
+checkExpr (InfixApply     _ e1 op e2) = do
   visitQId (opName op)
   mapM_ checkExpr [e1, e2]
-checkExpr (LeftSection         e _) = checkExpr e
-checkExpr (RightSection        _ e) = checkExpr e
-checkExpr (Lambda             ps e) = inNestedScope $ do
+checkExpr (LeftSection         _ e _) = checkExpr e
+checkExpr (RightSection        _ _ e) = checkExpr e
+checkExpr (Lambda             _ ps e) = inNestedScope $ do
   mapM_ checkPattern ps
   mapM_ (insertPattern False) ps
   checkExpr e
   reportUnusedVars
-checkExpr (Let                ds e) = inNestedScope $ do
+checkExpr (Let                _ ds e) = inNestedScope $ do
   checkLocalDeclGroup ds
   checkExpr e
   reportUnusedVars
-checkExpr (Do                sts e) = checkStatements sts e
-checkExpr (IfThenElse     e1 e2 e3) = mapM_ checkExpr [e1, e2, e3]
-checkExpr (Case          ct e alts) = do
+checkExpr (Do                _ sts e) = checkStatements sts e
+checkExpr (IfThenElse     _ e1 e2 e3) = mapM_ checkExpr [e1, e2, e3]
+checkExpr (Case          _ ct e alts) = do
   checkExpr e
   mapM_ checkAlt alts
   checkCaseAlts ct alts
@@ -428,9 +435,9 @@
   reportUnusedVars
 
 checkStatement :: Statement () -> WCM ()
-checkStatement (StmtExpr   e) = checkExpr e
-checkStatement (StmtDecl  ds) = checkLocalDeclGroup ds
-checkStatement (StmtBind p e) = do
+checkStatement (StmtExpr   _ e) = checkExpr e
+checkStatement (StmtDecl  _ ds) = checkLocalDeclGroup ds
+checkStatement (StmtBind _ p e) = do
   checkPattern p >> insertPattern False p
   checkExpr e
 
@@ -447,14 +454,14 @@
 -- Check for orphan instances
 -- -----------------------------------------------------------------------------
 
-checkOrphanInstance :: Position -> Context -> QualIdent -> TypeExpr -> WCM ()
+checkOrphanInstance :: SpanInfo -> Context -> QualIdent -> TypeExpr -> WCM ()
 checkOrphanInstance p cx cls ty = warnFor WarnOrphanInstances $ do
   m <- getModuleIdent
   tcEnv <- gets tyConsEnv
   let ocls = getOrigName m cls tcEnv
       otc  = getOrigName m tc  tcEnv
   unless (isLocalIdent m ocls || isLocalIdent m otc) $ report $
-    warnOrphanInstance p $ ppDecl $ InstanceDecl p cx cls ty []
+    warnOrphanInstance (spanInfo2Pos p) $ ppDecl $ InstanceDecl p cx cls ty []
   where tc = typeConstr ty
 
 warnOrphanInstance :: Position -> Doc -> Message
@@ -464,14 +471,14 @@
 -- Check for missing method implementations
 -- -----------------------------------------------------------------------------
 
-checkMissingMethodImplementations :: Position -> QualIdent -> [Decl a] -> WCM ()
+checkMissingMethodImplementations :: SpanInfo -> QualIdent -> [Decl a] -> WCM ()
 checkMissingMethodImplementations p cls ds = warnFor WarnMissingMethods $ do
   m <- getModuleIdent
   tcEnv <- gets tyConsEnv
   clsEnv <- gets classEnv
   let ocls = getOrigName m cls tcEnv
       ms   = classMethods ocls clsEnv
-  mapM_ (report . warnMissingMethodImplementation p) $
+  mapM_ (report . warnMissingMethodImplementation (spanInfo2Pos p)) $
     filter ((null fs ||) . not . flip (hasDefaultImpl ocls) clsEnv) $ ms \\ fs
   where fs = map unRenameIdent $ concatMap impls ds
 
@@ -535,8 +542,8 @@
   "WarnCheck.warnAliasNameClash: empty list"
 warnAliasNameClash mids = posMessage (head mids) $ text
   "Overlapping module aliases" $+$ nest 2 (vcat (map myppAlias mids))
-  where myppAlias mid@(ModuleIdent pos _) =
-          ppLine pos <> text ":" <+> text (escModuleName mid)
+  where myppAlias mid =
+          ppLine (getPosition mid) <> text ":" <+> text (escModuleName mid)
 
 -- -----------------------------------------------------------------------------
 -- Check for overlapping/unreachable and non-exhaustive case alternatives
@@ -544,7 +551,7 @@
 
 checkCaseAlts :: CaseType -> [Alt ()] -> WCM ()
 checkCaseAlts _  []                   = ok
-checkCaseAlts ct alts@(Alt p _ _ : _) = do
+checkCaseAlts ct alts@(Alt spi _ _ : _) = do
   let pats = map (\(Alt _ pat _) -> [pat]) alts
   (nonExhaustive, overlapped, nondet) <- checkPatternMatching pats
   case ct of
@@ -558,6 +565,7 @@
         warnMissingPattern p "a case alternative" nonExhaustive
       unless (null overlapped) $ warnFor WarnOverlapping $ report $
         warnUnreachablePattern p overlapped
+  where p = spanInfo2Pos spi
 
 -- -----------------------------------------------------------------------------
 -- Check for non-exhaustive and overlapping patterns.
@@ -595,35 +603,37 @@
 --   * Constructors
 -- All other patterns like as-patterns, list patterns and alike are desugared.
 simplifyPat :: Pattern () -> WCM (Pattern ())
-simplifyPat p@(LiteralPattern      _ l) = return $ case l of
-  String s -> simplifyListPattern $ map (LiteralPattern () . Char) s
+simplifyPat p@(LiteralPattern        _ _ l) = return $ case l of
+  String s -> simplifyListPattern $ map (LiteralPattern NoSpanInfo () . Char) s
   _        -> p
-simplifyPat (NegativePattern       a l) = return $ LiteralPattern a (negateLit l)
+simplifyPat (NegativePattern       spi a l) =
+  return $ LiteralPattern spi a (negateLit l)
   where
   negateLit (Int   n) = Int   (-n)
   negateLit (Float d) = Float (-d)
   negateLit x         = x
-simplifyPat v@(VariablePattern     _ _) = return v
-simplifyPat (ConstructorPattern a c ps) =
-  ConstructorPattern a c `liftM` mapM simplifyPat ps
-simplifyPat (InfixPattern    a p1 c p2) =
-  ConstructorPattern a c `liftM` mapM simplifyPat [p1, p2]
-simplifyPat (ParenPattern            p) = simplifyPat p
-simplifyPat (RecordPattern      _ c fs) = do
+simplifyPat v@(VariablePattern       _ _ _) = return v
+simplifyPat (ConstructorPattern spi a c ps) =
+  ConstructorPattern spi a c `liftM` mapM simplifyPat ps
+simplifyPat (InfixPattern    spi a p1 c p2) =
+  ConstructorPattern spi a c `liftM` mapM simplifyPat [p1, p2]
+simplifyPat (ParenPattern              _ p) = simplifyPat p
+simplifyPat (RecordPattern        _ _ c fs) = do
   (_, ls) <- getAllLabels c
   let ps = map (getPattern (map field2Tuple fs)) ls
-  simplifyPat (ConstructorPattern () c ps)
+  simplifyPat (ConstructorPattern NoSpanInfo () c ps)
   where
     getPattern fs' l' =
       fromMaybe wildPat (lookup l' [(unqualify l, p) | (l, p) <- fs'])
-simplifyPat (TuplePattern           ps) =
-  ConstructorPattern () (qTupleId (length ps)) `liftM` mapM simplifyPat ps
-simplifyPat (ListPattern          _ ps) =
+simplifyPat (TuplePattern            _ ps) =
+  ConstructorPattern NoSpanInfo () (qTupleId (length ps))
+    `liftM` mapM simplifyPat ps
+simplifyPat (ListPattern           _ _ ps) =
   simplifyListPattern `liftM` mapM simplifyPat ps
-simplifyPat (AsPattern             _ p) = simplifyPat p
-simplifyPat (LazyPattern             _) = return wildPat
-simplifyPat (FunctionPattern     _ _ _) = return wildPat
-simplifyPat (InfixFuncPattern  _ _ _ _) = return wildPat
+simplifyPat (AsPattern             _ _ p) = simplifyPat p
+simplifyPat (LazyPattern             _ _) = return wildPat
+simplifyPat (FunctionPattern     _ _ _ _) = return wildPat
+simplifyPat (InfixFuncPattern  _ _ _ _ _) = return wildPat
 
 getAllLabels :: QualIdent -> WCM (QualIdent, [Ident])
 getAllLabels c = do
@@ -635,8 +645,9 @@
 
 -- |Create a simplified list pattern by applying @:@ and @[]@.
 simplifyListPattern :: [Pattern ()] -> Pattern ()
-simplifyListPattern = foldr (\p1 p2 -> ConstructorPattern () qConsId [p1, p2])
-                            (ConstructorPattern () qNilId [])
+simplifyListPattern =
+  foldr (\p1 p2 -> ConstructorPattern NoSpanInfo () qConsId [p1, p2])
+        (ConstructorPattern NoSpanInfo () qNilId [])
 
 -- |'ExhaustivePats' describes those pattern missing for an exhaustive
 -- pattern matching, where a value can be thought of as a missing equation.
@@ -685,7 +696,7 @@
   -- default alternatives (variable pattern)
   defaults   = [ shiftPat q' | q' <- qs, isVarPat (firstPat q') ]
   -- Pattern for all non-matched literals
-  defaultPat = ( VariablePattern () newVar :
+  defaultPat = ( VariablePattern NoSpanInfo () newVar :
                    replicate (length (snd q) - 1) wildPat
                , [(newVar, usedLits)]
                )
@@ -702,7 +713,8 @@
     let qs' = [shiftPat q | q <- qs, isVarLit lit (firstPat q)]
         ovlp = length qs' > 1
     (missing, used, nd) <- processEqs qs'
-    return ( map (\(xs, ys) -> (LiteralPattern () lit : xs, ys)) missing
+    return ( map (\(xs, ys) -> (LiteralPattern NoSpanInfo () lit : xs, ys))
+                 missing
            , used
            , nd && ovlp
            )
@@ -733,7 +745,7 @@
   defaults     = [ shiftPat q' | q' <- qs, isVarPat (firstPat q') ]
   -- Pattern for a non-matched constructors
   defaultPat c = (mkPattern c : replicate (length (snd q) - 1) wildPat, [])
-  mkPattern  c = ConstructorPattern ()
+  mkPattern  c = ConstructorPattern NoSpanInfo ()
                   (qualifyLike (fst $ head used_cons) (constrIdent c))
                   (replicate (length $ constrTypes c) wildPat)
 
@@ -751,7 +763,7 @@
     return (map (\(xs, ys) -> (makeCon c a xs, ys)) missing, used, nd && ovlp)
 
   makeCon c a ps = let (args, rest) = splitAt a ps
-                   in ConstructorPattern () c args : rest
+                   in ConstructorPattern NoSpanInfo () c args : rest
 
   removeFirstCon c a (n, p:ps)
     | isVarPat p = (n, replicate a wildPat ++ ps)
@@ -810,29 +822,30 @@
 --   * Convert a list constructor pattern representing a finite list
 --     into a list pattern
 tidyPat :: Pattern () -> WCM (Pattern ())
-tidyPat p@(LiteralPattern        _ _) = return p
-tidyPat p@(VariablePattern       _ _) = return p
-tidyPat p@(ConstructorPattern _ c ps)
+tidyPat p@(LiteralPattern        _ _ _) = return p
+tidyPat p@(VariablePattern       _ _ _) = return p
+tidyPat p@(ConstructorPattern _ _ c ps)
   | isQTupleId c                      =
-    TuplePattern `liftM` mapM tidyPat ps
+    TuplePattern NoSpanInfo `liftM` mapM tidyPat ps
   | c == qConsId && isFiniteList p    =
-    ListPattern () `liftM` mapM tidyPat (unwrapFinite p)
+    ListPattern NoSpanInfo () `liftM` mapM tidyPat (unwrapFinite p)
   | c == qConsId                      = unwrapInfinite p
   | otherwise                         =
-    ConstructorPattern () c `liftM` mapM tidyPat ps
+    ConstructorPattern NoSpanInfo () c `liftM` mapM tidyPat ps
   where
-  isFiniteList (ConstructorPattern _ d []     )                = d == qNilId
-  isFiniteList (ConstructorPattern _ d [_, e2]) | d == qConsId = isFiniteList e2
-  isFiniteList _                                               = False
+  isFiniteList (ConstructorPattern _ _ d []     ) = d == qNilId
+  isFiniteList (ConstructorPattern _ _ d [_, e2])
+                                   | d == qConsId = isFiniteList e2
+  isFiniteList _                                  = False
 
-  unwrapFinite (ConstructorPattern _ _ []     ) = []
-  unwrapFinite (ConstructorPattern _ _ [p1,p2]) = p1 : unwrapFinite p2
+  unwrapFinite (ConstructorPattern _ _ _ []     ) = []
+  unwrapFinite (ConstructorPattern _ _ _ [p1,p2]) = p1 : unwrapFinite p2
   unwrapFinite pat
     = internalError $ "WarnCheck.tidyPat.unwrapFinite: " ++ show pat
 
-  unwrapInfinite (ConstructorPattern a d [p1,p2]) =
-    liftM2 (flip (InfixPattern a) d) (tidyPat p1) (unwrapInfinite p2)
-  unwrapInfinite p0                               = return p0
+  unwrapInfinite (ConstructorPattern _ a d [p1,p2]) =
+    liftM2 (flip (InfixPattern NoSpanInfo a) d) (tidyPat p1) (unwrapInfinite p2)
+  unwrapInfinite p0                                 = return p0
 
 tidyPat p = internalError $ "Checks.WarnCheck.tidyPat: " ++ show p
 
@@ -848,17 +861,17 @@
 
 -- |Wildcard pattern.
 wildPat :: Pattern ()
-wildPat = VariablePattern () anonId
+wildPat = VariablePattern NoSpanInfo () anonId
 
 -- |Retrieve any literal out of a pattern.
 getLit :: Pattern a -> [Literal]
-getLit (LiteralPattern _ l) = [l]
-getLit _                    = []
+getLit (LiteralPattern _ _ l) = [l]
+getLit _                      = []
 
 -- |Retrieve the constructor name and its arity for a pattern.
 getCon :: Pattern a -> [(QualIdent, Int)]
-getCon (ConstructorPattern _ c ps) = [(c, length ps)]
-getCon _                           = []
+getCon (ConstructorPattern _ _ c ps) = [(c, length ps)]
+getCon _                             = []
 
 -- |Is a pattern a variable or literal pattern?
 isVarLit :: Literal -> Pattern a -> Bool
@@ -870,33 +883,33 @@
 
 -- |Is a pattern a pattern matching for the given constructor?
 isCon :: QualIdent -> Pattern a -> Bool
-isCon c (ConstructorPattern _ d _) = c == d
-isCon _ _                          = False
+isCon c (ConstructorPattern _ _ d _) = c == d
+isCon _ _                            = False
 
 -- |Is a pattern a pattern matching for the given literal?
 isLit :: Literal -> Pattern a -> Bool
-isLit l (LiteralPattern _ m) = l == m
-isLit _ _                    = False
+isLit l (LiteralPattern _ _ m) = l == m
+isLit _ _                      = False
 
 -- |Is a pattern a literal pattern?
 isLitPat :: Pattern a -> Bool
-isLitPat (LiteralPattern  _ _) = True
-isLitPat _                     = False
+isLitPat (LiteralPattern  _ _ _) = True
+isLitPat _                       = False
 
 -- |Is a pattern a variable pattern?
 isVarPat :: Pattern a -> Bool
-isVarPat (VariablePattern _ _) = True
-isVarPat _                     = False
+isVarPat (VariablePattern _ _ _) = True
+isVarPat _                       = False
 
 -- |Is a pattern a constructor pattern?
 isConPat :: Pattern a -> Bool
-isConPat (ConstructorPattern _ _ _) = True
-isConPat _                          = False
+isConPat (ConstructorPattern _ _ _ _) = True
+isConPat _                            = False
 
 -- |Retrieve the arguments of a pattern.
 patArgs :: Pattern a -> [Pattern a]
-patArgs (ConstructorPattern _ _ ps) = ps
-patArgs _                           = []
+patArgs (ConstructorPattern _ _ _ ps) = ps
+patArgs _                             = []
 
 -- |Warning message for non-exhaustive patterns.
 -- To shorten the output only the first 'maxPattern' are printed,
@@ -916,7 +929,7 @@
     | otherwise = ppPats <+> text "with" <+> hsep (map ppCons cs)
     where ppPats = hsep (map (ppPattern 2) ps)
   ppCons (i, lits) = ppIdent i <+> text "`notElem`"
-                 <+> ppExpr 0 (List () (map (Literal ()) lits))
+            <+> ppExpr 0 (List NoSpanInfo () (map (Literal NoSpanInfo ()) lits))
 
 -- |Warning message for unreachable patterns.
 -- To shorten the output only the first 'maxPattern' are printed,
@@ -995,14 +1008,14 @@
 insertDecl _                         = ok
 
 insertTypeExpr :: TypeExpr -> WCM ()
-insertTypeExpr (VariableType        _) = ok
-insertTypeExpr (ConstructorType     _) = ok
-insertTypeExpr (ApplyType     ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2]
-insertTypeExpr (TupleType         tys) = mapM_ insertTypeExpr tys
-insertTypeExpr (ListType           ty) = insertTypeExpr ty
-insertTypeExpr (ArrowType     ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2]
-insertTypeExpr (ParenType          ty) = insertTypeExpr ty
-insertTypeExpr (ForallType       _ ty) = insertTypeExpr ty
+insertTypeExpr (VariableType       _ _) = ok
+insertTypeExpr (ConstructorType    _ _) = ok
+insertTypeExpr (ApplyType    _ ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2]
+insertTypeExpr (TupleType        _ tys) = mapM_ insertTypeExpr tys
+insertTypeExpr (ListType          _ ty) = insertTypeExpr ty
+insertTypeExpr (ArrowType    _ ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2]
+insertTypeExpr (ParenType         _ ty) = insertTypeExpr ty
+insertTypeExpr (ForallType      _ _ ty) = insertTypeExpr ty
 
 insertConstrDecl :: ConstrDecl -> WCM ()
 insertConstrDecl (ConstrDecl _ _ _    c _) = insertConsId c
@@ -1019,27 +1032,27 @@
 -- necessary to determine whether a constructor pattern represents a
 -- constructor or a function.
 insertPattern :: Bool -> Pattern a -> WCM ()
-insertPattern fp (VariablePattern        _ v) = do
+insertPattern fp (VariablePattern       _ _ v) = do
   cons <- isConsId v
   unless cons $ do
     var <- isVarId v
     if and [fp, var, not (isAnonId v)] then visitId v else insertVar v
-insertPattern fp (ConstructorPattern  _ c ps) = do
+insertPattern fp (ConstructorPattern _ _ c ps) = do
   cons <- isQualConsId c
   mapM_ (insertPattern (not cons || fp)) ps
-insertPattern fp (InfixPattern     a p1 c p2)
-  = insertPattern fp (ConstructorPattern a c [p1, p2])
-insertPattern fp (ParenPattern             p) = insertPattern fp p
-insertPattern fp (RecordPattern       _ _ fs) = mapM_ (insertFieldPattern fp) fs
-insertPattern fp (TuplePattern            ps) = mapM_ (insertPattern fp) ps
-insertPattern fp (ListPattern           _ ps) = mapM_ (insertPattern fp) ps
-insertPattern fp (AsPattern              v p) = insertVar v >> insertPattern fp p
-insertPattern fp (LazyPattern              p) = insertPattern fp p
-insertPattern _  (FunctionPattern     _ f ps) = do
+insertPattern fp (InfixPattern    spi a p1 c p2)
+  = insertPattern fp (ConstructorPattern spi a c [p1, p2])
+insertPattern fp (ParenPattern          _ p) = insertPattern fp p
+insertPattern fp (RecordPattern    _ _ _ fs) = mapM_ (insertFieldPattern fp) fs
+insertPattern fp (TuplePattern         _ ps) = mapM_ (insertPattern fp) ps
+insertPattern fp (ListPattern        _ _ ps) = mapM_ (insertPattern fp) ps
+insertPattern fp (AsPattern           _ v p) = insertVar v >> insertPattern fp p
+insertPattern fp (LazyPattern           _ p) = insertPattern fp p
+insertPattern _  (FunctionPattern  _ _ f ps) = do
   visitQId f
   mapM_ (insertPattern True) ps
-insertPattern _  (InfixFuncPattern a p1 f p2)
-  = insertPattern True (FunctionPattern a f [p1, p2])
+insertPattern _  (InfixFuncPattern spi a p1 f p2)
+  = insertPattern True (FunctionPattern spi a f [p1, p2])
 insertPattern _ _ = ok
 
 insertFieldPattern :: Bool -> Field (Pattern a) -> WCM ()
@@ -1272,26 +1285,26 @@
 checkCaseModeContext = mapM_ checkCaseModeConstraint
 
 checkCaseModeConstraint :: Constraint -> WCM ()
-checkCaseModeConstraint (Constraint _ ty) = checkCaseModeTypeExpr ty
+checkCaseModeConstraint (Constraint _ _ ty) = checkCaseModeTypeExpr ty
 
 checkCaseModeTypeExpr :: TypeExpr -> WCM ()
-checkCaseModeTypeExpr (ApplyType ty1 ty2) = do
+checkCaseModeTypeExpr (ApplyType _ ty1 ty2) = do
   checkCaseModeTypeExpr ty1
   checkCaseModeTypeExpr ty2
-checkCaseModeTypeExpr (VariableType tv) = checkCaseModeID isVarName tv
-checkCaseModeTypeExpr (TupleType tys) = mapM_ checkCaseModeTypeExpr tys
-checkCaseModeTypeExpr (ListType ty) = checkCaseModeTypeExpr ty
-checkCaseModeTypeExpr (ArrowType ty1 ty2) = do
+checkCaseModeTypeExpr (VariableType _ tv) = checkCaseModeID isVarName tv
+checkCaseModeTypeExpr (TupleType _ tys) = mapM_ checkCaseModeTypeExpr tys
+checkCaseModeTypeExpr (ListType _ ty) = checkCaseModeTypeExpr ty
+checkCaseModeTypeExpr (ArrowType _ ty1 ty2) = do
   checkCaseModeTypeExpr ty1
   checkCaseModeTypeExpr ty2
-checkCaseModeTypeExpr (ParenType ty) = checkCaseModeTypeExpr ty
-checkCaseModeTypeExpr (ForallType tvs ty) = do
+checkCaseModeTypeExpr (ParenType _ ty) = checkCaseModeTypeExpr ty
+checkCaseModeTypeExpr (ForallType _ tvs ty) = do
   mapM_ (checkCaseModeID isVarName) tvs
   checkCaseModeTypeExpr ty
 checkCaseModeTypeExpr _ = ok
 
 checkCaseModeQualTypeExpr :: QualTypeExpr -> WCM ()
-checkCaseModeQualTypeExpr (QualTypeExpr cx ty) = do
+checkCaseModeQualTypeExpr (QualTypeExpr _ cx ty) = do
   checkCaseModeContext cx
   checkCaseModeTypeExpr ty
 
@@ -1301,14 +1314,14 @@
   checkCaseModeRhs rhs
 
 checkCaseModeLhs :: Lhs a -> WCM ()
-checkCaseModeLhs (FunLhs f ts) = do
+checkCaseModeLhs (FunLhs _ f ts) = do
   checkCaseModeID isFuncName f
   mapM_ checkCaseModePattern ts
-checkCaseModeLhs (OpLhs t1 f t2) = do
+checkCaseModeLhs (OpLhs _ t1 f t2) = do
   checkCaseModePattern t1
   checkCaseModeID isFuncName f
   checkCaseModePattern t2
-checkCaseModeLhs (ApLhs lhs ts) = do
+checkCaseModeLhs (ApLhs _ lhs ts) = do
   checkCaseModeLhs lhs
   mapM_ checkCaseModePattern ts
 
@@ -1316,7 +1329,7 @@
 checkCaseModeRhs (SimpleRhs _ e ds) = do
   checkCaseModeExpr e
   mapM_ checkCaseModeDecl ds
-checkCaseModeRhs (GuardedRhs es ds) = do
+checkCaseModeRhs (GuardedRhs _ es ds) = do
   mapM_ checkCaseModeCondExpr es
   mapM_ checkCaseModeDecl ds
 
@@ -1326,81 +1339,83 @@
   checkCaseModeExpr e
 
 checkCaseModePattern :: Pattern a -> WCM ()
-checkCaseModePattern (VariablePattern _ v) = checkCaseModeID isVarName v
-checkCaseModePattern (ConstructorPattern _ _ ts) = mapM_ checkCaseModePattern ts
-checkCaseModePattern (InfixPattern _ t1 _ t2) = do
+checkCaseModePattern (VariablePattern _ _ v) = checkCaseModeID isVarName v
+checkCaseModePattern (ConstructorPattern _ _ _ ts) =
+  mapM_ checkCaseModePattern ts
+checkCaseModePattern (InfixPattern _ _ t1 _ t2) = do
   checkCaseModePattern t1
   checkCaseModePattern t2
-checkCaseModePattern (ParenPattern t) = checkCaseModePattern t
-checkCaseModePattern (RecordPattern _ _ fs) = mapM_ checkCaseModeFieldPattern fs
-checkCaseModePattern (TuplePattern ts) = mapM_ checkCaseModePattern ts
-checkCaseModePattern (ListPattern _ ts) = mapM_ checkCaseModePattern ts
-checkCaseModePattern (AsPattern v t) = do
+checkCaseModePattern (ParenPattern _ t) = checkCaseModePattern t
+checkCaseModePattern (RecordPattern _ _ _ fs) =
+  mapM_ checkCaseModeFieldPattern fs
+checkCaseModePattern (TuplePattern _ ts) = mapM_ checkCaseModePattern ts
+checkCaseModePattern (ListPattern _ _ ts) = mapM_ checkCaseModePattern ts
+checkCaseModePattern (AsPattern _ v t) = do
   checkCaseModeID isVarName v
   checkCaseModePattern t
-checkCaseModePattern (LazyPattern t) = checkCaseModePattern t
-checkCaseModePattern (FunctionPattern _ _ ts) = mapM_ checkCaseModePattern ts
-checkCaseModePattern (InfixFuncPattern _ t1 _ t2) = do
+checkCaseModePattern (LazyPattern _ t) = checkCaseModePattern t
+checkCaseModePattern (FunctionPattern _ _ _ ts) = mapM_ checkCaseModePattern ts
+checkCaseModePattern (InfixFuncPattern _ _ t1 _ t2) = do
   checkCaseModePattern t1
   checkCaseModePattern t2
 checkCaseModePattern _ = ok
 
 checkCaseModeExpr :: Expression a -> WCM ()
-checkCaseModeExpr (Paren e) = checkCaseModeExpr e
-checkCaseModeExpr (Typed e qty) = do
+checkCaseModeExpr (Paren _ e) = checkCaseModeExpr e
+checkCaseModeExpr (Typed _ e qty) = do
   checkCaseModeExpr e
   checkCaseModeQualTypeExpr qty
-checkCaseModeExpr (Record _ _ fs) = mapM_ checkCaseModeFieldExpr fs
-checkCaseModeExpr (RecordUpdate e fs) = do
+checkCaseModeExpr (Record _ _ _ fs) = mapM_ checkCaseModeFieldExpr fs
+checkCaseModeExpr (RecordUpdate _ e fs) = do
   checkCaseModeExpr e
   mapM_ checkCaseModeFieldExpr fs
-checkCaseModeExpr (Tuple es) = mapM_ checkCaseModeExpr es
-checkCaseModeExpr (List  _ es) = mapM_ checkCaseModeExpr es
-checkCaseModeExpr (ListCompr e stms)  = do
+checkCaseModeExpr (Tuple _ es) = mapM_ checkCaseModeExpr es
+checkCaseModeExpr (List _ _ es) = mapM_ checkCaseModeExpr es
+checkCaseModeExpr (ListCompr _ e stms)  = do
   checkCaseModeExpr e
   mapM_ checkCaseModeStatement stms
-checkCaseModeExpr (EnumFrom e) = checkCaseModeExpr e
-checkCaseModeExpr (EnumFromThen e1 e2) = do
+checkCaseModeExpr (EnumFrom _ e) = checkCaseModeExpr e
+checkCaseModeExpr (EnumFromThen _ e1 e2) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
-checkCaseModeExpr (EnumFromTo e1 e2) = do
+checkCaseModeExpr (EnumFromTo _ e1 e2) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
-checkCaseModeExpr (EnumFromThenTo e1 e2 e3) = do
+checkCaseModeExpr (EnumFromThenTo _ e1 e2 e3) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
   checkCaseModeExpr e3
-checkCaseModeExpr (UnaryMinus e) = checkCaseModeExpr e
-checkCaseModeExpr (Apply e1 e2) = do
+checkCaseModeExpr (UnaryMinus _ e) = checkCaseModeExpr e
+checkCaseModeExpr (Apply _ e1 e2) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
-checkCaseModeExpr (InfixApply e1 _ e2) = do
+checkCaseModeExpr (InfixApply _ e1 _ e2) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
-checkCaseModeExpr (LeftSection e _) = checkCaseModeExpr e
-checkCaseModeExpr (RightSection _ e) = checkCaseModeExpr e
-checkCaseModeExpr (Lambda ts e) = do
+checkCaseModeExpr (LeftSection _ e _) = checkCaseModeExpr e
+checkCaseModeExpr (RightSection _ _ e) = checkCaseModeExpr e
+checkCaseModeExpr (Lambda _ ts e) = do
   mapM_ checkCaseModePattern ts
   checkCaseModeExpr e
-checkCaseModeExpr (Let ds e) = do
+checkCaseModeExpr (Let _ ds e) = do
   mapM_ checkCaseModeDecl ds
   checkCaseModeExpr e
-checkCaseModeExpr (Do stms e) = do
+checkCaseModeExpr (Do _ stms e) = do
   mapM_ checkCaseModeStatement stms
   checkCaseModeExpr e
-checkCaseModeExpr (IfThenElse e1 e2 e3) = do
+checkCaseModeExpr (IfThenElse _ e1 e2 e3) = do
   checkCaseModeExpr e1
   checkCaseModeExpr e2
   checkCaseModeExpr e3
-checkCaseModeExpr (Case _ e as) = do
+checkCaseModeExpr (Case _ _ e as) = do
   mapM_ checkCaseModeAlt as
   checkCaseModeExpr e
 checkCaseModeExpr _ = ok
 
 checkCaseModeStatement :: Statement a -> WCM ()
-checkCaseModeStatement (StmtExpr e) = checkCaseModeExpr e
-checkCaseModeStatement (StmtDecl ds) = mapM_ checkCaseModeDecl ds
-checkCaseModeStatement (StmtBind t e) = do
+checkCaseModeStatement (StmtExpr _ e) = checkCaseModeExpr e
+checkCaseModeStatement (StmtDecl _ ds) = mapM_ checkCaseModeDecl ds
+checkCaseModeStatement (StmtBind _ t e) = do
   checkCaseModePattern t
   checkCaseModeExpr e
 
@@ -1453,8 +1468,8 @@
   text "try renaming to" <+> text (caseSuggestion name) <+> text "instead"
 
 caseSuggestion :: String -> String
-caseSuggestion (x:xs) | isLower x = (toUpper x : xs)
-                      | isUpper x = (toLower x : xs)
+caseSuggestion (x:xs) | isLower x = toUpper x : xs
+                      | isUpper x = toLower x : xs
 caseSuggestion _      = internalError
  "Checks.WarnCheck.caseSuggestion: Identifier starts with illegal Symbol"
 
diff --git a/src/CompilerOpts.hs b/src/CompilerOpts.hs
--- a/src/CompilerOpts.hs
+++ b/src/CompilerOpts.hs
@@ -5,9 +5,10 @@
                        2007        Sebastian Fischer
                        2011 - 2016 Björn Peemöller
                        2016 - 2017 Finn Teegen
+                       2018        Kai-Oliver Prott
     License     :  BSD-3-clause
 
-    Maintainer  :  bjp@informatik.uni-kiel.de
+    Maintainer  :  fte@informatik.uni-kiel.de
     Stability   :  experimental
     Portability :  portable
 
@@ -175,12 +176,16 @@
 -- |Type of the target file
 data TargetType
   = Tokens               -- ^ Source code tokens
+  | Comments             -- ^ Source code comments
   | Parsed               -- ^ Parsed source code
   | FlatCurry            -- ^ FlatCurry
   | TypedFlatCurry       -- ^ Typed FlatCurry
-  | AbstractCurry        -- ^ AbstractCurry
-  | UntypedAbstractCurry -- ^ Untyped AbstractCurry
-  | Html                 -- ^ HTML documentation
+  | TypeAnnotatedFlatCurry -- ^ Type-annotated FlatCurry
+  | AbstractCurry          -- ^ AbstractCurry
+  | UntypedAbstractCurry   -- ^ Untyped AbstractCurry
+  | Html                   -- ^ HTML documentation
+  | AST                  -- ^ Abstract-Syntax-Tree after checks
+  | ShortAST             -- ^ Abstract-Syntax-Tree with shortened decls
     deriving (Eq, Show)
 
 -- |Warnings flags
@@ -421,20 +426,28 @@
         addFlag WarnOverlapping (wnWarnFlags opts) }))
       "do not print warnings for overlapping rules"
   -- target types
-  , targetOption Tokens               "tokens"
+  , targetOption Tokens                 "tokens"
       "generate token stream"
-  , targetOption Parsed               "parse-only"
+  , targetOption Comments               "comments"
+      "generate comments stream"
+  , targetOption Parsed                 "parse-only"
       "generate source representation"
-  , targetOption FlatCurry            "flat"
+  , targetOption FlatCurry              "flat"
       "generate FlatCurry code"
-  , targetOption TypedFlatCurry       "typed-flat"
+  , targetOption TypedFlatCurry         "typed-flat"
       "generate typed FlatCurry code"
-  , targetOption AbstractCurry        "acy"
+  , targetOption TypeAnnotatedFlatCurry "type-annotated-flat"
+      "generate type-annotated FlatCurry code"
+  , targetOption AbstractCurry          "acy"
       "generate typed AbstractCurry"
-  , targetOption UntypedAbstractCurry "uacy"
+  , targetOption UntypedAbstractCurry   "uacy"
       "generate untyped AbstractCurry"
-  , targetOption Html                 "html"
+  , targetOption Html                   "html"
       "generate html documentation"
+  , targetOption AST                    "ast"
+      "generate abstract syntax tree"
+  , targetOption ShortAST               "short-ast"
+      "generate shortened abstract syntax tree for documentation"
   , Option "F"  []
       (NoArg (onPrepOpts $ \ opts -> opts { ppPreprocess = True }))
       "use custom preprocessor"
diff --git a/src/CurryBuilder.hs b/src/CurryBuilder.hs
--- a/src/CurryBuilder.hs
+++ b/src/CurryBuilder.hs
@@ -4,9 +4,10 @@
     Copyright   :  (c) 2005        Martin Engelke
                        2007        Sebastian Fischer
                        2011 - 2015 Björn Peemöller
+                       2018        Kai-Oliver Prott
     License     :  BSD-3-clause
 
-    Maintainer  :  bjp@informatik.uni-kiel.de
+    Maintainer  :  fte@informatik.uni-kiel.de
     Stability   :  experimental
     Portability :  portable
 
@@ -23,6 +24,7 @@
 import Curry.Base.Ident
 import Curry.Base.Monad
 import Curry.Base.Position (Position)
+import Curry.Base.SpanInfo (spanInfo2Pos)
 import Curry.Base.Pretty
 import Curry.Files.Filenames
 import Curry.Files.PathUtils
@@ -112,8 +114,8 @@
   let opts1 = foldl processLanguagePragma opts0
                 [ e | LanguagePragma _ es <- ps, KnownExtension _ e <- es ]
   foldM processOptionPragma opts1 $
-    [ (p, s) | OptionsPragma p (Just FRONTEND) s <- ps ] ++
-      [ (p, s) | OptionsPragma p (Just CYMAKE) s <- ps ]
+    [ (spanInfo2Pos p, s) | OptionsPragma p (Just FRONTEND) s <- ps ] ++
+      [ (spanInfo2Pos p, s) | OptionsPragma p (Just CYMAKE) s <- ps ]
   where
   processLanguagePragma opts CPP
     = opts { optCppOpts = (optCppOpts opts) { cppRun = True } }
@@ -165,12 +167,16 @@
 
   destFiles = [ gen fn | (t, gen) <- nameGens, t `elem` optTargetTypes opts]
   nameGens  =
-    [ (Tokens              , tgtDir . tokensName   )
-    , (Parsed              , tgtDir . sourceRepName)
-    , (FlatCurry           , tgtDir . flatName     )
-    , (TypedFlatCurry      , tgtDir . typedFlatName)
-    , (AbstractCurry       , tgtDir . acyName      )
-    , (UntypedAbstractCurry, tgtDir . uacyName     )
+    [ (Tokens              , tgtDir . tokensName       )
+    , (Comments            , tgtDir . commentsName)
+    , (Parsed              , tgtDir . sourceRepName    )
+    , (FlatCurry           , tgtDir . flatName         )
+    , (TypedFlatCurry      , tgtDir . typedFlatName    )
+    , (TypeAnnotatedFlatCurry, tgtDir . typeAnnFlatName)
+    , (AbstractCurry       , tgtDir . acyName          )
+    , (UntypedAbstractCurry, tgtDir . uacyName         )
+    , (AST                 , tgtDir . astName          )
+    , (ShortAST            , tgtDir . shortASTName     )
     , (Html                , const (fromMaybe "." (optHtmlDir opts) </> htmlName m))
     ]
 
diff --git a/src/CurryDeps.hs b/src/CurryDeps.hs
--- a/src/CurryDeps.hs
+++ b/src/CurryDeps.hs
@@ -16,10 +16,14 @@
     information between Curry modules. This is used to create Makefile
     dependencies and to update programs composed of multiple modules.
 -}
-
+{-# LANGUAGE CPP #-}
 module CurryDeps
   ( Source (..), flatDeps, deps, flattenDeps, sourceDeps, moduleDeps ) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 import           Control.Monad   (foldM)
 import           Data.List       (isSuffixOf, nub)
 import qualified Data.Map as Map (Map, empty, insert, lookup, toList)
@@ -96,7 +100,7 @@
 
 -- |Retrieve the dependencies of a given module
 moduleDeps :: Options -> SourceEnv -> FilePath -> Module a -> CYIO SourceEnv
-moduleDeps opts sEnv fn mdl@(Module ps m _ _ _) = case Map.lookup m sEnv of
+moduleDeps opts sEnv fn mdl@(Module _ ps m _ _ _) = case Map.lookup m sEnv of
   Just  _ -> return sEnv
   Nothing -> do
     let imps  = imports opts mdl
@@ -106,7 +110,7 @@
 -- |Retrieve the imported modules and add the import of the Prelude
 -- according to the compiler options.
 imports :: Options -> Module a -> [ModuleIdent]
-imports opts mdl@(Module _ m _ is _) = nub $
+imports opts mdl@(Module _ _ m _ is _) = nub $
      [preludeMIdent | m /= preludeMIdent && not noImplicitPrelude]
   ++ [m' | ImportDecl _ m' _ _ _ <- is]
   where noImplicitPrelude = NoImplicitPrelude `elem` optExtensions opts
@@ -125,9 +129,9 @@
         | icurryExt `isSuffixOf` fn ->
             return $ Map.insert m (Interface fn) sEnv
         | otherwise                 -> do
-            hdr@(Module _ m' _ _ _) <- readHeader opts fn
-            if (m == m') then moduleDeps opts sEnv fn hdr
-                         else failMessages [errWrongModule m m']
+            hdr@(Module _ _ m' _ _ _) <- readHeader opts fn
+            if m == m' then moduleDeps opts sEnv fn hdr
+                       else failMessages [errWrongModule m m']
 
 readHeader :: Options -> FilePath -> CYIO (Module ())
 readHeader opts fn = do
diff --git a/src/Env/TypeConstructor.hs b/src/Env/TypeConstructor.hs
--- a/src/Env/TypeConstructor.hs
+++ b/src/Env/TypeConstructor.hs
@@ -45,13 +45,17 @@
     exported at all in order to make the interface more stable against
     changes which are private to the module.
 -}
-
+{-# LANGUAGE CPP #-}
 module Env.TypeConstructor
   ( TypeInfo (..), tcKind, clsKind, varKind, clsMethods
   , TCEnv, initTCEnv, bindTypeInfo, rebindTypeInfo
   , lookupTypeInfo, qualLookupTypeInfo, qualLookupTypeInfoUnique
   , getOrigName, reverseLookupByOrigName
   ) where
+
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
 
 import Curry.Base.Ident
 import Curry.Base.Pretty (Pretty(..), blankLine)
diff --git a/src/Env/Value.hs b/src/Env/Value.hs
--- a/src/Env/Value.hs
+++ b/src/Env/Value.hs
@@ -22,7 +22,7 @@
     information. On import two values are considered equal if their original
     names match.
 -}
-
+{-# LANGUAGE CPP #-}
 module Env.Value
   ( ValueEnv, ValueInfo (..)
   , bindGlobalInfo, bindFun, qualBindFun, rebindFun, unbindFun
@@ -30,6 +30,10 @@
   , initDCEnv
   , ValueType (..), bindLocalVars, bindLocalVar
   ) where
+
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
 
 import Curry.Base.Ident
 import Curry.Base.Pretty (Pretty(..))
diff --git a/src/Exports.hs b/src/Exports.hs
--- a/src/Exports.hs
+++ b/src/Exports.hs
@@ -21,11 +21,12 @@
 
 import           Data.List         (nub)
 import qualified Data.Map   as Map (foldrWithKey, toList)
-import           Data.Maybe        (catMaybes)
+import           Data.Maybe        (mapMaybe)
 import qualified Data.Set   as Set ( Set, empty, insert, deleteMin, fromList
                                    , member, toList )
 
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Ident
 import Curry.Syntax
 
@@ -62,10 +63,10 @@
 -- exported function.
 
 exportInterface :: CompilerEnv -> Module a -> Interface
-exportInterface env (Module _ m (Just (Exporting _ es)) _ _) =
+exportInterface env (Module _ _ m (Just (Exporting _ es)) _ _) =
   exportInterface' m es (opPrecEnv env) (tyConsEnv env) (valueEnv env)
     (classEnv env) (instEnv env)
-exportInterface _   (Module _ _ Nothing                 _ _) =
+exportInterface _   (Module _ _ _ Nothing                 _ _) =
   internalError "Exports.exportInterface: no export specification"
 
 exportInterface' :: ModuleIdent -> [Export] -> OpPrecEnv -> TCEnv -> ValueEnv
@@ -73,7 +74,7 @@
 exportInterface' m es pEnv tcEnv vEnv clsEnv inEnv = Interface m imports decls'
   where
   tvs     = filter (`notElem` tcs) identSupply
-  tcs     = catMaybes $ map (localIdent m) $ definedTypes decls'
+  tcs     = mapMaybe (localIdent m) $ definedTypes decls'
   imports = map (IImportDecl NoPos) $ usedModules decls'
   precs   = foldr (infixDecl m pEnv) [] es
   types   = foldr (typeDecl m tcEnv clsEnv tvs) [] es
@@ -83,8 +84,8 @@
   decls'  = closeInterface m tcEnv clsEnv inEnv tvs Set.empty decls
 
 infixDecl :: ModuleIdent -> OpPrecEnv -> Export -> [IDecl] -> [IDecl]
-infixDecl m pEnv (Export             f) ds = iInfixDecl m pEnv f ds
-infixDecl m pEnv (ExportTypeWith tc cs) ds =
+infixDecl m pEnv (Export             _ f) ds = iInfixDecl m pEnv f ds
+infixDecl m pEnv (ExportTypeWith _ tc cs) ds =
   foldr (iInfixDecl m pEnv . qualifyLike tc) ds cs
 infixDecl _ _ _ _ = internalError "Exports.infixDecl: no pattern match"
 
@@ -103,8 +104,8 @@
 
 typeDecl :: ModuleIdent -> TCEnv -> ClassEnv -> [Ident] -> Export -> [IDecl]
          -> [IDecl]
-typeDecl _ _     _      _   (Export             _) ds = ds
-typeDecl m tcEnv clsEnv tvs (ExportTypeWith tc xs) ds =
+typeDecl _ _     _      _   (Export             _ _) ds = ds
+typeDecl m tcEnv clsEnv tvs (ExportTypeWith _ tc xs) ds =
   case qualLookupTypeInfo tc tcEnv of
     [DataType tc' k cs]
       | null xs   -> iTypeDecl IDataDecl m tvs tc' k []  [] : ds
@@ -128,7 +129,8 @@
             ty'  = fromQualType m tvs' ty
     [TypeClass qcls k ms] -> IClassDecl NoPos cx qcls' k' tv ms' hs : ds
       where qcls' = qualUnqualify m qcls
-            cx    = [ Constraint (qualUnqualify m scls) (VariableType tv)
+            cx    = [ Constraint NoSpanInfo (qualUnqualify m scls)
+                        (VariableType NoSpanInfo tv)
                     | scls <- superClasses qcls clsEnv ]
             k'    = fromKind' k 0
             tv    = head tvs
@@ -146,26 +148,28 @@
 
 constrDecl :: ModuleIdent -> Int -> [Ident] -> DataConstr -> ConstrDecl
 constrDecl m n tvs (DataConstr c n' ps [ty1, ty2])
-  | isInfixOp c = ConOpDecl NoPos evs cx ty1' c ty2'
+  | isInfixOp c = ConOpDecl NoSpanInfo evs cx ty1' c ty2'
   where evs          = take n' $ drop n tvs
         cx           = fromQualPredSet m tvs ps
         [ty1', ty2'] = map (fromQualType m tvs) [ty1, ty2]
-constrDecl m n tvs (DataConstr c n' ps tys) = ConstrDecl NoPos evs cx c tys'
+constrDecl m n tvs (DataConstr c n' ps tys) =
+  ConstrDecl NoSpanInfo evs cx c tys'
   where evs  = take n' $ drop n tvs
         cx   = fromQualPredSet m tvs ps
         tys' = map (fromQualType m tvs) tys
-constrDecl m n tvs (RecordConstr c n' ps ls tys) = RecordDecl NoPos evs cx c fs
+constrDecl m n tvs (RecordConstr c n' ps ls tys) =
+  RecordDecl NoSpanInfo evs cx c fs
   where
     evs  = take n' $ drop n tvs
     cx   = fromQualPredSet m tvs ps
     tys' = map (fromQualType m tvs) tys
-    fs   = zipWith (FieldDecl NoPos . return) ls tys'
+    fs   = zipWith (FieldDecl NoSpanInfo . return) ls tys'
 
 newConstrDecl :: ModuleIdent -> [Ident] -> DataConstr -> NewConstrDecl
 newConstrDecl m tvs (DataConstr c _ _ tys)
-  = NewConstrDecl NoPos c (fromQualType m tvs (head tys))
+  = NewConstrDecl NoSpanInfo c (fromQualType m tvs (head tys))
 newConstrDecl m tvs (RecordConstr c _ _ ls tys)
-  = NewRecordDecl NoPos c (head ls, fromQualType m tvs (head tys))
+  = NewRecordDecl NoSpanInfo c (head ls, fromQualType m tvs (head tys))
 
 -- When exporting a class method, we have to remove the implicit class context.
 -- Due to the sorting of the predicate set, this is fortunatly very easy. The
@@ -177,12 +181,12 @@
   fromQualPredType m tvs $ PredType (Set.deleteMin ps) ty
 
 valueDecl :: ModuleIdent -> ValueEnv -> [Ident] -> Export -> [IDecl] -> [IDecl]
-valueDecl m vEnv tvs (Export      f) ds = case qualLookupValue f vEnv of
+valueDecl m vEnv tvs (Export     _ f) ds = case qualLookupValue f vEnv of
   [Value _ cm a (ForAll _ pty)] ->
     IFunctionDecl NoPos (qualUnqualify m f)
       (if cm then Just (head tvs) else Nothing) a (fromQualPredType m tvs pty) : ds
   _ -> internalError $ "Exports.valueDecl: " ++ show f
-valueDecl _ _ _ (ExportTypeWith _ _) ds = ds
+valueDecl _ _ _ (ExportTypeWith _ _ _) ds = ds
 valueDecl _ _ _ _ _ = internalError "Exports.valueDecl: no pattern match"
 
 instDecl :: ModuleIdent -> TCEnv -> [Ident] -> InstIdent -> InstInfo -> [IDecl]
@@ -197,7 +201,7 @@
   IInstanceDecl NoPos cx (qualUnqualify m cls) ty is mm
   where pty = PredType ps $ applyType (TypeConstructor tc) $
                 map TypeVariable [0 .. n-1]
-        QualTypeExpr cx ty = fromQualPredType m tvs pty
+        QualTypeExpr _ cx ty = fromQualPredType m tvs pty
         n = kindArity (tcKind m tc tcEnv) - kindArity (clsKind m cls tcEnv)
         mm = if m == m' then Nothing else Just m'
 
@@ -261,20 +265,20 @@
   modules (IMethodDecl _ _ _ qty) = modules qty
 
 instance HasModule Constraint where
-  modules (Constraint cls ty) = modules cls . modules ty
+  modules (Constraint _ cls ty) = modules cls . modules ty
 
 instance HasModule TypeExpr where
-  modules (ConstructorType tc) = modules tc
-  modules (ApplyType  ty1 ty2) = modules ty1 . modules ty2
-  modules (VariableType     _) = id
-  modules (TupleType      tys) = modules tys
-  modules (ListType        ty) = modules ty
-  modules (ArrowType  ty1 ty2) = modules ty1 . modules ty2
-  modules (ParenType       ty) = modules ty
-  modules (ForallType    _ ty) = modules ty
+  modules (ConstructorType _ tc) = modules tc
+  modules (ApplyType  _ ty1 ty2) = modules ty1 . modules ty2
+  modules (VariableType     _ _) = id
+  modules (TupleType      _ tys) = modules tys
+  modules (ListType        _ ty) = modules ty
+  modules (ArrowType  _ ty1 ty2) = modules ty1 . modules ty2
+  modules (ParenType       _ ty) = modules ty
+  modules (ForallType    _ _ ty) = modules ty
 
 instance HasModule QualTypeExpr where
-  modules (QualTypeExpr cx ty) = modules cx . modules ty
+  modules (QualTypeExpr _ cx ty) = modules cx . modules ty
 
 instance HasModule QualIdent where
   modules = modules . qidModule
@@ -334,7 +338,8 @@
                       k' = fromKind' k n
                   in  HidingDataDecl NoPos tc k' $ take n tvs
                 hidingClassDecl k sclss =
-                  let cx = [ Constraint (qualUnqualify m scls) (VariableType tv)
+                  let cx = [ Constraint NoSpanInfo (qualUnqualify m scls)
+                               (VariableType NoSpanInfo tv)
                            | scls <- sclss ]
                       tv = head tvs
                       k' = fromKind' k 0
@@ -409,17 +414,17 @@
   usedTypes (IMethodDecl _ _ _ qty) = usedTypes qty
 
 instance HasType Constraint where
-  usedTypes (Constraint cls ty) = (cls :) . usedTypes ty
+  usedTypes (Constraint _ cls ty) = (cls :) . usedTypes ty
 
 instance HasType TypeExpr where
-  usedTypes (ConstructorType tc) = (tc :)
-  usedTypes (ApplyType ty1 ty2) = usedTypes ty1 . usedTypes ty2
-  usedTypes (VariableType     _) = id
-  usedTypes (TupleType      tys) = usedTypes tys
-  usedTypes (ListType        ty) = usedTypes ty
-  usedTypes (ArrowType  ty1 ty2) = usedTypes ty1 . usedTypes ty2
-  usedTypes (ParenType       ty) = usedTypes ty
-  usedTypes (ForallType    _ ty) = usedTypes ty
+  usedTypes (ConstructorType _ tc) = (tc :)
+  usedTypes (ApplyType _ ty1 ty2) = usedTypes ty1 . usedTypes ty2
+  usedTypes (VariableType     _ _) = id
+  usedTypes (TupleType      _ tys) = usedTypes tys
+  usedTypes (ListType        _ ty) = usedTypes ty
+  usedTypes (ArrowType  _ ty1 ty2) = usedTypes ty1 . usedTypes ty2
+  usedTypes (ParenType       _ ty) = usedTypes ty
+  usedTypes (ForallType    _ _ ty) = usedTypes ty
 
 instance HasType QualTypeExpr where
-  usedTypes (QualTypeExpr cx ty) = usedTypes cx . usedTypes ty
+  usedTypes (QualTypeExpr _ cx ty) = usedTypes cx . usedTypes ty
diff --git a/src/Generators.hs b/src/Generators.hs
--- a/src/Generators.hs
+++ b/src/Generators.hs
@@ -3,9 +3,10 @@
     Description :  Code generators
     Copyright   :  (c) 2011        Björn Peemöller
                        2017        Finn Teegen
+                       2018        Kai-Oliver Prott
     License     :  BSD-3-clause
 
-    Maintainer  :  bjp@informatik.uni-kiel.de
+    Maintainer  :  fte@informatik.uni-kiel.de
     Stability   :  experimental
     Portability :  portable
 
@@ -13,16 +14,19 @@
 -}
 module Generators where
 
-import qualified Curry.AbstractCurry              as AC   (CurryProg)
-import qualified Curry.FlatCurry.Type             as FC   (Prog)
-import qualified Curry.FlatCurry.Annotated.Type   as AFC  (AProg, TypeExpr)
-import qualified Curry.Syntax                     as CS   (Module)
+import qualified Curry.AbstractCurry            as AC   (CurryProg)
+import qualified Curry.FlatCurry.Type           as FC   (Prog, TypeExpr)
+import qualified Curry.FlatCurry.Annotated.Type as AFC  (AProg)
+import qualified Curry.FlatCurry.Typed.Type     as TFC  (TProg)
+import qualified Curry.Syntax                   as CS   (Module)
 
-import qualified Generators.GenAbstractCurry      as GAC  (genAbstractCurry)
-import qualified Generators.GenFlatCurry          as GFC  ( genFlatCurry
-                                                          , genFlatInterface
-                                                          )
-import qualified Generators.GenTypedFlatCurry     as GTFC (genTypedFlatCurry)
+import qualified Generators.GenAbstractCurry    as GAC   (genAbstractCurry)
+import qualified Generators.GenFlatCurry        as GFC   ( genFlatCurry
+                                                           , genFlatInterface
+                                                           )
+import qualified Generators.GenTypeAnnotatedFlatCurry
+                                                as GTAFC (genTypeAnnotatedFlatCurry)
+import qualified Generators.GenTypedFlatCurry   as GTFC  (genTypedFlatCurry)
 
 import           Base.Types                          (Type, PredType)
 
@@ -39,11 +43,16 @@
 
 -- |Generate typed FlatCurry
 genTypedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-                  -> AFC.AProg AFC.TypeExpr
+                  -> TFC.TProg
 genTypedFlatCurry = GTFC.genTypedFlatCurry
 
+-- |Generate type-annotated FlatCurry
+genTypeAnnotatedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
+                          -> AFC.AProg FC.TypeExpr
+genTypeAnnotatedFlatCurry = GTAFC.genTypeAnnotatedFlatCurry
+
 -- |Generate FlatCurry
-genFlatCurry :: AFC.AProg a -> FC.Prog
+genFlatCurry :: TFC.TProg -> FC.Prog
 genFlatCurry = GFC.genFlatCurry
 
 -- |Generate a FlatCurry interface
diff --git a/src/Generators/GenAbstractCurry.hs b/src/Generators/GenAbstractCurry.hs
--- a/src/Generators/GenAbstractCurry.hs
+++ b/src/Generators/GenAbstractCurry.hs
@@ -31,6 +31,7 @@
 
 import Curry.AbstractCurry
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.CurryTypes (fromPredType, toType, toPredType)
@@ -62,7 +63,7 @@
 -- ---------------------------------------------------------------------------
 
 trModule :: Module PredType -> GAC CurryProg
-trModule (Module _ mid _ is ds) = do
+trModule (Module _ _ mid _ is ds) =
   CurryProg mid' is' <$> dflt' <*> cds' <*> ids' <*> ts' <*> fs' <*> os'
   where
   mid'  = moduleName mid
@@ -83,7 +84,7 @@
 trDefaultDecl _                   = return []
 
 trClassDecl :: Decl PredType -> GAC [CClassDecl]
-trClassDecl (ClassDecl _ cx cls tv ds) = do
+trClassDecl (ClassDecl _ cx cls tv ds) =
   (\cls' v' cx' tv' ds' -> [CClass cls' v' cx' tv' ds'])
     <$> trGlobalIdent cls <*> getTypeVisibility cls <*> trContext cx
     <*> getTVarIndex tv <*> concatMapM (trClassMethodDecl sigs fs) ds
@@ -99,7 +100,7 @@
                   -> GAC [CFuncDecl]
 trClassMethodDecl sigs fs (TypeSig p [f] _) | f `notElem` fs =
   trClassMethodDecl sigs fs $ FunctionDecl p undefined f []
-trClassMethodDecl sigs fs (TypeSig p (f:f':fs') qty) = do
+trClassMethodDecl sigs fs (TypeSig p (f:f':fs') qty) =
   liftM2 (++) (trClassMethodDecl sigs fs $ TypeSig p [f] qty)
               (trClassMethodDecl sigs fs $ TypeSig p (f':fs') qty)
 trClassMethodDecl sigs _ (FunctionDecl _ _ f eqs) =
@@ -121,7 +122,8 @@
 trInstanceMethodDecl qcls ty (FunctionDecl _ _ f eqs) = do
   uacy <- S.gets untypedAcy
   qty <- if uacy
-           then return $ QualTypeExpr [] $ ConstructorType prelUntyped
+           then return $ QualTypeExpr NoSpanInfo [] $
+                           ConstructorType NoSpanInfo prelUntyped
            else getQualType' (qualifyLike qcls $ unRenameIdent f)
   CFunc <$> trLocalIdent f <*> pure (eqnArity $ head eqs) <*> pure Public
         <*> trInstanceMethodType ty qty <*> mapM trEquation eqs
@@ -131,10 +133,10 @@
 -- the class variable with the given instance type. The implicit class context
 -- is dropped in doing so.
 trInstanceMethodType :: TypeExpr -> QualTypeExpr -> GAC CQualTypeExpr
-trInstanceMethodType ity (QualTypeExpr cx ty) =
+trInstanceMethodType ity (QualTypeExpr _ cx ty) =
   trQualTypeExpr $ fromPredType identSupply $
     subst (bindSubst 0 (toType [] ity) idSubst) $
-      toPredType (take 1 identSupply) $ QualTypeExpr (drop 1 cx) ty
+      toPredType (take 1 identSupply) $ QualTypeExpr NoSpanInfo (drop 1 cx) ty
 
 trTypeDecl :: Decl a -> GAC [CTypeDecl]
 trTypeDecl (DataDecl    _ t vs cs clss) =
@@ -150,6 +152,9 @@
   <$> trGlobalIdent t <*> getTypeVisibility t
   <*> mapM genTVarIndex vs <*> trNewConsDecl nc
   <*> mapM trQual clss
+trTypeDecl (ExternalDataDecl _ t vs) =
+  (\t' v vs' -> [CType t' v vs' [] []])
+  <$> trGlobalIdent t <*> getTypeVisibility t <*> mapM genTVarIndex vs
 trTypeDecl _                       = return []
 
 trConsDecl :: ConstrDecl -> GAC CConsDecl
@@ -173,25 +178,26 @@
   <$> trGlobalIdent nc <*> getVisibility nc <*> trFieldDecl (FieldDecl p [l] ty)
 
 trTypeExpr :: TypeExpr -> GAC CTypeExpr
-trTypeExpr (ConstructorType q) = CTCons <$> trQual q
-trTypeExpr (ApplyType ty1 ty2) = CTApply <$> trTypeExpr ty1 <*> trTypeExpr ty2
-trTypeExpr (VariableType    v) = CTVar  <$> getTVarIndex v
-trTypeExpr (TupleType     tys) =
-  trTypeExpr $ foldl ApplyType (ConstructorType $ qTupleId $ length tys) tys
-trTypeExpr (ListType       ty) =
-  trTypeExpr $ ApplyType (ConstructorType qListId) ty
-trTypeExpr (ArrowType ty1 ty2) = CFuncType <$> trTypeExpr ty1 <*> trTypeExpr ty2
-trTypeExpr (ParenType      ty) = trTypeExpr ty
-trTypeExpr (ForallType    _ _) = internalError "GenAbstractCurry.trTypeExpr"
+trTypeExpr (ConstructorType _ q) = CTCons <$> trQual q
+trTypeExpr (ApplyType _ ty1 ty2) = CTApply <$> trTypeExpr ty1 <*> trTypeExpr ty2
+trTypeExpr (VariableType    _ v) = CTVar  <$> getTVarIndex v
+trTypeExpr (TupleType     _ tys) =
+  trTypeExpr $ foldl (ApplyType NoSpanInfo)
+                     (ConstructorType NoSpanInfo $ qTupleId $ length tys) tys
+trTypeExpr (ListType       _ ty) =
+  trTypeExpr $ ApplyType NoSpanInfo (ConstructorType NoSpanInfo qListId) ty
+trTypeExpr (ArrowType _ ty1 ty2) = CFuncType <$> trTypeExpr ty1 <*> trTypeExpr ty2
+trTypeExpr (ParenType      _ ty) = trTypeExpr ty
+trTypeExpr (ForallType    _ _ _) = internalError "GenAbstractCurry.trTypeExpr"
 
 trConstraint :: Constraint -> GAC CConstraint
-trConstraint (Constraint q ty) = (,) <$> trQual q <*> trTypeExpr ty
+trConstraint (Constraint _ q ty) = (,) <$> trQual q <*> trTypeExpr ty
 
 trContext :: Context -> GAC CContext
 trContext cx = CContext <$> mapM trConstraint cx
 
 trQualTypeExpr :: QualTypeExpr -> GAC CQualTypeExpr
-trQualTypeExpr (QualTypeExpr cx ty) =
+trQualTypeExpr (QualTypeExpr _ cx ty) =
   CQualType <$> trContext cx <*> trTypeExpr ty
 
 trInfixDecl :: Decl a -> GAC [COpDecl]
@@ -229,7 +235,7 @@
 trRhs (SimpleRhs _ e ds) = inNestedScope $ do
   mapM_ insertDeclLhs ds
   CSimpleRhs <$> trExpr e <*> concatMapM trLocalDecl ds
-trRhs (GuardedRhs gs ds) = inNestedScope $ do
+trRhs (GuardedRhs _ gs ds) = inNestedScope $ do
   mapM_ insertDeclLhs ds
   CGuardedRhs <$> mapM trCondExpr gs <*> concatMapM trLocalDecl ds
 
@@ -267,85 +273,89 @@
 insertSig _                 = return ()
 
 trExpr :: Expression PredType -> GAC CExpr
-trExpr (Literal       _ l) = return (CLit $ cvLiteral l)
-trExpr (Variable      _ v)
+trExpr (Literal       _ _ l) = return (CLit $ cvLiteral l)
+trExpr (Variable      _ _ v)
   | isQualified v = CSymbol <$> trQual v
   | otherwise     = lookupVarIndex (unqualify v) >>= \mvi -> case mvi of
     Just vi -> return (CVar vi)
     _       -> CSymbol <$> trQual v
-trExpr (Constructor   _ c) = CSymbol <$> trQual c
-trExpr (Paren           e) = trExpr e
-trExpr (Typed       e qty) = CTyped <$> trExpr e <*> trQualTypeExpr qty
-trExpr (Record     _ c fs) = CRecConstr <$> trQual c
-                                        <*> mapM (trField trExpr) fs
-trExpr (RecordUpdate e fs) = CRecUpdate <$> trExpr e
-                                        <*> mapM (trField trExpr) fs
-trExpr (Tuple          es) =
-  trExpr $ apply (Variable undefined $ qTupleId $ length es) es
-trExpr (List         _ es) =
-  trExpr $ foldr (Apply . Apply (Constructor undefined qConsId))
-                 (Constructor undefined qNilId)
+trExpr (Constructor   _ _ c) = CSymbol <$> trQual c
+trExpr (Paren           _ e) = trExpr e
+trExpr (Typed       _ e qty) = CTyped <$> trExpr e <*> trQualTypeExpr qty
+trExpr (Record     _ _ c fs) = CRecConstr <$> trQual c
+                                          <*> mapM (trField trExpr) fs
+trExpr (RecordUpdate _ e fs) = CRecUpdate <$> trExpr e
+                                          <*> mapM (trField trExpr) fs
+trExpr (Tuple          _ es) =
+  trExpr $ apply (Variable NoSpanInfo undefined $ qTupleId $ length es) es
+trExpr (List         _ _ es) =
+  trExpr $ foldr (Apply NoSpanInfo . Apply NoSpanInfo
+                   (Constructor NoSpanInfo undefined qConsId))
+                 (Constructor NoSpanInfo undefined qNilId)
                  es
-trExpr (ListCompr    e ds) = inNestedScope $ flip CListComp
-                             <$> mapM trStatement ds <*> trExpr e
-trExpr (EnumFrom              e) =
-  trExpr $ apply (Variable undefined qEnumFromId) [e]
-trExpr (EnumFromThen      e1 e2) =
-  trExpr $ apply (Variable undefined qEnumFromThenId) [e1, e2]
-trExpr (EnumFromTo        e1 e2) =
-  trExpr $ apply (Variable undefined qEnumFromToId) [e1, e2]
-trExpr (EnumFromThenTo e1 e2 e3) =
-  trExpr $ apply (Variable undefined qEnumFromThenToId) [e1, e2, e3]
-trExpr (UnaryMinus            e) =
-  trExpr $ apply (Variable undefined qNegateId) [e]
-trExpr (Apply             e1 e2) = CApply <$> trExpr e1 <*> trExpr e2
-trExpr (InfixApply     e1 op e2) = trExpr $ apply (infixOp op) [e1, e2]
-trExpr (LeftSection        e op) = trExpr $ apply (infixOp op) [e]
-trExpr (RightSection       op e) =
-  trExpr $ apply (Variable undefined qFlip) [infixOp op, e]
-trExpr (Lambda             ps e) = inNestedScope $
-                                   CLambda <$> mapM trPat ps <*> trExpr e
-trExpr (Let                ds e) = inNestedScope $
-                                   CLetDecl <$> trLocalDecls ds <*> trExpr e
-trExpr (Do                 ss e) = inNestedScope $
-                                   (\ss' e' -> CDoExpr (ss' ++ [CSExpr e']))
-                                   <$> mapM trStatement ss <*> trExpr e
-trExpr (IfThenElse     e1 e2 e3) =
-  trExpr $ apply (Variable undefined qIfThenElseId) [e1, e2, e3]
-trExpr (Case            ct e bs) = CCase (cvCaseType ct)
-                                   <$> trExpr e <*> mapM trAlt bs
+trExpr (ListCompr    _ e ds) = inNestedScope $ flip CListComp
+                               <$> mapM trStatement ds <*> trExpr e
+trExpr (EnumFrom              _ e) =
+  trExpr $ apply (Variable NoSpanInfo undefined qEnumFromId) [e]
+trExpr (EnumFromThen      _ e1 e2) =
+  trExpr $ apply (Variable NoSpanInfo undefined qEnumFromThenId) [e1, e2]
+trExpr (EnumFromTo        _ e1 e2) =
+  trExpr $ apply (Variable NoSpanInfo undefined qEnumFromToId) [e1, e2]
+trExpr (EnumFromThenTo _ e1 e2 e3) =
+  trExpr $ apply (Variable NoSpanInfo undefined qEnumFromThenToId) [e1, e2, e3]
+trExpr (UnaryMinus            _ e) =
+  trExpr $ apply (Variable NoSpanInfo undefined qNegateId) [e]
+trExpr (Apply             _ e1 e2) = CApply <$> trExpr e1 <*> trExpr e2
+trExpr (InfixApply     _ e1 op e2) = trExpr $ apply (infixOp op) [e1, e2]
+trExpr (LeftSection        _ e op) = trExpr $ apply (infixOp op) [e]
+trExpr (RightSection       _ op e) =
+  trExpr $ apply (Variable NoSpanInfo undefined qFlip) [infixOp op, e]
+trExpr (Lambda             _ ps e) = inNestedScope $
+                                     CLambda <$> mapM trPat ps <*> trExpr e
+trExpr (Let                _ ds e) = inNestedScope $
+                                     CLetDecl <$> trLocalDecls ds <*> trExpr e
+trExpr (Do                 _ ss e) = inNestedScope $
+                                     (\ss' e' -> CDoExpr (ss' ++ [CSExpr e']))
+                                     <$> mapM trStatement ss <*> trExpr e
+trExpr (IfThenElse     _ e1 e2 e3) =
+  trExpr $ apply (Variable NoSpanInfo undefined qIfThenElseId) [e1, e2, e3]
+trExpr (Case            _ ct e bs) = CCase (cvCaseType ct)
+                                     <$> trExpr e <*> mapM trAlt bs
 
 cvCaseType :: CaseType -> CCaseType
 cvCaseType Flex  = CFlex
 cvCaseType Rigid = CRigid
 
 trStatement :: Statement PredType -> GAC CStatement
-trStatement (StmtExpr   e) = CSExpr     <$> trExpr e
-trStatement (StmtDecl  ds) = CSLet      <$> trLocalDecls ds
-trStatement (StmtBind p e) = flip CSPat <$> trExpr e <*> trPat p
+trStatement (StmtExpr _   e) = CSExpr     <$> trExpr e
+trStatement (StmtDecl _  ds) = CSLet      <$> trLocalDecls ds
+trStatement (StmtBind _ p e) = flip CSPat <$> trExpr e <*> trPat p
 
 trAlt :: Alt PredType -> GAC (CPattern, CRhs)
 trAlt (Alt _ p rhs) = inNestedScope $ (,) <$> trPat p <*> trRhs rhs
 
 trPat :: Pattern a -> GAC CPattern
-trPat (LiteralPattern         _ l) = return (CPLit $ cvLiteral l)
-trPat (VariablePattern        _ v) = CPVar <$> getVarIndex v
-trPat (ConstructorPattern  _ c ps) = CPComb <$> trQual c <*> mapM trPat ps
-trPat (InfixPattern    a p1 op p2) = trPat $ ConstructorPattern a op [p1, p2]
-trPat (ParenPattern             p) = trPat p
-trPat (RecordPattern       _ c fs) = CPRecord <$> trQual c
+trPat (LiteralPattern         _ _ l) = return (CPLit $ cvLiteral l)
+trPat (VariablePattern        _ _ v) = CPVar <$> getVarIndex v
+trPat (ConstructorPattern  _ _ c ps) = CPComb <$> trQual c <*> mapM trPat ps
+trPat (InfixPattern    _ a p1 op p2) =
+  trPat $ ConstructorPattern NoSpanInfo a op [p1, p2]
+trPat (ParenPattern             _ p) = trPat p
+trPat (RecordPattern       _ _ c fs) = CPRecord <$> trQual c
                                               <*> mapM (trField trPat) fs
-trPat (TuplePattern            ps) =
-  trPat $ ConstructorPattern undefined (qTupleId $ length ps) ps
-trPat (ListPattern           _ ps) = trPat $
-  foldr (\x1 x2 -> ConstructorPattern undefined qConsId [x1, x2])
-        (ConstructorPattern undefined qNilId [])
+trPat (TuplePattern            _ ps) =
+  trPat $ ConstructorPattern NoSpanInfo undefined (qTupleId $ length ps) ps
+trPat (ListPattern           _ _ ps) = trPat $
+  foldr (\x1 x2 -> ConstructorPattern NoSpanInfo undefined qConsId [x1, x2])
+        (ConstructorPattern NoSpanInfo undefined qNilId [])
         ps
-trPat (NegativePattern        a l) = trPat $ LiteralPattern a $ negateLiteral l
-trPat (AsPattern              v p) = CPAs <$> getVarIndex v<*> trPat p
-trPat (LazyPattern              p) = CPLazy <$> trPat p
-trPat (FunctionPattern     _ f ps) = CPFuncComb <$> trQual f <*> mapM trPat ps
-trPat (InfixFuncPattern a p1 f p2) = trPat (FunctionPattern a f [p1, p2])
+trPat (NegativePattern        _ a l) =
+  trPat $ LiteralPattern NoSpanInfo a $ negateLiteral l
+trPat (AsPattern              _ v p) = CPAs <$> getVarIndex v<*> trPat p
+trPat (LazyPattern              _ p) = CPLazy <$> trPat p
+trPat (FunctionPattern     _ _ f ps) = CPFuncComb <$> trQual f <*> mapM trPat ps
+trPat (InfixFuncPattern _ a p1 f p2) =
+  trPat (FunctionPattern NoSpanInfo a f [p1, p2])
 
 trField :: (a -> GAC b) -> Field a -> GAC (CField b)
 trField act (Field _ l x) = (,) <$> trQual l <*> act x
@@ -408,7 +418,7 @@
 
 -- |Initialize the AbstractCurry generator environment
 abstractEnv :: Bool -> CompilerEnv -> Module a -> AbstractEnv
-abstractEnv uacy env (Module _ mid es _ ds) = AbstractEnv
+abstractEnv uacy env (Module _ _ mid es _ ds) = AbstractEnv
   { moduleId   = mid
   , typeEnv    = valueEnv env
   , tyExports  = foldr (buildTypeExports  mid) Set.empty es'
@@ -428,15 +438,15 @@
 
 -- Builds a table containing all exported identifiers from a module.
 buildTypeExports :: ModuleIdent -> Export -> Set.Set Ident -> Set.Set Ident
-buildTypeExports mid (ExportTypeWith tc _)
+buildTypeExports mid (ExportTypeWith _ tc _)
   | isLocalIdent mid tc = Set.insert (unqualify tc)
 buildTypeExports _   _  = id
 
 -- Builds a table containing all exported identifiers from a module.
 buildValueExports :: ModuleIdent -> Export -> Set.Set Ident -> Set.Set Ident
-buildValueExports mid (Export             q)
+buildValueExports mid (Export             _ q)
   | isLocalIdent mid q  = Set.insert (unqualify q)
-buildValueExports mid (ExportTypeWith tc cs)
+buildValueExports mid (ExportTypeWith _ tc cs)
   | isLocalIdent mid tc = flip (foldr Set.insert) cs
 buildValueExports _   _  = id
 
@@ -505,7 +515,8 @@
   uacy <- S.gets untypedAcy
   sigs <- S.gets typeSigs
   trQualTypeExpr $ case uacy of
-    True  -> Maybe.fromMaybe (QualTypeExpr [] $ ConstructorType prelUntyped)
+    True  -> Maybe.fromMaybe (QualTypeExpr NoSpanInfo [] $
+                               ConstructorType NoSpanInfo prelUntyped)
                              (Map.lookup f sigs)
     False -> fromPredType identSupply pty
 
diff --git a/src/Generators/GenFlatCurry.hs b/src/Generators/GenFlatCurry.hs
--- a/src/Generators/GenFlatCurry.hs
+++ b/src/Generators/GenFlatCurry.hs
@@ -15,39 +15,39 @@
 
 import Curry.FlatCurry.Goodies
 import Curry.FlatCurry.Type
-import Curry.FlatCurry.Annotated.Goodies
-import Curry.FlatCurry.Annotated.Type
+import Curry.FlatCurry.Typed.Goodies
+import Curry.FlatCurry.Typed.Type
 
 -- transforms annotated FlatCurry code to FlatCurry code
-genFlatCurry :: AProg a -> Prog
-genFlatCurry = trAProg
+genFlatCurry :: TProg -> Prog
+genFlatCurry = trTProg
   (\name imps types funcs ops ->
     Prog name imps types (map genFlatFuncDecl funcs) ops)
 
-genFlatFuncDecl :: AFuncDecl a -> FuncDecl
-genFlatFuncDecl = trAFunc
+genFlatFuncDecl :: TFuncDecl -> FuncDecl
+genFlatFuncDecl = trTFunc
   (\name arity vis ty rule -> Func name arity vis ty $ genFlatRule rule)
 
-genFlatRule :: ARule a -> Rule
-genFlatRule = trARule
-  (\_ args e -> Rule (map fst args) $ genFlatExpr e)
+genFlatRule :: TRule -> Rule
+genFlatRule = trTRule
+  (\args e -> Rule (map fst args) $ genFlatExpr e)
   (const External)
 
-genFlatExpr :: AExpr a -> Expr
-genFlatExpr = trAExpr
+genFlatExpr :: TExpr -> Expr
+genFlatExpr = trTExpr
   (const Var)
   (const Lit)
-  (\_ ct name args -> Comb ct (fst name) args)
-  (\_ bs e -> Let (map (\(v, e') -> (fst v, e')) bs) e)
-  (\_ vs e -> Free (map fst vs) e)
-  (\_ e1 e2 -> Or e1 e2)
-  (\_ ct e bs -> Case ct e bs)
+  (\_ ct name args -> Comb ct name args)
+  (\bs e -> Let (map (\(v, e') -> (fst v, e')) bs) e)
+  (\vs e -> Free (map fst vs) e)
+  Or
+  Case
   (\pat e -> Branch (genFlatPattern pat) e)
-  (\_ e ty -> Typed e ty)
+  Typed
 
-genFlatPattern :: APattern a -> Pattern
-genFlatPattern = trAPattern
-  (\_ name args -> Pattern (fst name) $ map fst args)
+genFlatPattern :: TPattern -> Pattern
+genFlatPattern = trTPattern
+  (\_ name args -> Pattern name $ map fst args)
   (const LPattern)
 
 -- transforms a FlatCurry module to a FlatCurry interface
diff --git a/src/Generators/GenTypeAnnotatedFlatCurry.hs b/src/Generators/GenTypeAnnotatedFlatCurry.hs
new file mode 100644
--- /dev/null
+++ b/src/Generators/GenTypeAnnotatedFlatCurry.hs
@@ -0,0 +1,517 @@
+{- |
+    Module      :  $Header$
+    Description :  Generation of typed FlatCurry program terms
+    Copyright   :  (c) 2017        Finn Teegen
+                       2018        Kai-Oliver Prott
+    License     :  BSD-3-clause
+
+    Maintainer  :  fte@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    This module contains the generation of a type-annotated 'FlatCurry'
+    program term for a given module in the intermediate language.
+-}
+{-# LANGUAGE CPP #-}
+module Generators.GenTypeAnnotatedFlatCurry (genTypeAnnotatedFlatCurry) where
+
+#if __GLASGOW_HASKELL__ < 710
+import           Control.Applicative        ((<$>), (<*>))
+#endif
+import           Control.Monad              ((<=<))
+import           Control.Monad.Extra        (concatMapM)
+import qualified Control.Monad.State as S   ( State, evalState, get, gets
+                                            , modify, put )
+import           Data.Function              (on)
+import           Data.List                  (nub, sortBy)
+import           Data.Maybe                 (fromMaybe)
+import qualified Data.Map            as Map (Map, empty, insert, lookup)
+import qualified Data.Set            as Set (Set, empty, insert, member)
+
+import           Curry.Base.Ident
+import           Curry.Base.SpanInfo
+import           Curry.FlatCurry.Annotated.Goodies (typeName)
+import           Curry.FlatCurry.Annotated.Type
+import qualified Curry.Syntax as CS
+
+import Base.CurryTypes     (toType)
+import Base.Messages       (internalError)
+import Base.NestEnv        ( NestEnv, emptyEnv, bindNestEnv, lookupNestEnv
+                           , nestEnv, unnestEnv )
+import Base.TypeExpansion
+import Base.Types
+
+import CompilerEnv
+import Env.OpPrec          (mkPrec)
+import Env.TypeConstructor (TCEnv)
+import Env.Value           (ValueEnv, ValueInfo (..), qualLookupValue)
+
+import qualified IL
+import Transformations     (transType)
+
+-- TODO: Translate from TypedFlatCurry
+-- transforms intermediate language code (IL) to type-annotated FlatCurry code
+genTypeAnnotatedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
+                  -> AProg TypeExpr
+genTypeAnnotatedFlatCurry env mdl il = patchPrelude $ run env mdl (trModule il)
+
+-- -----------------------------------------------------------------------------
+-- Addition of primitive types for lists and tuples to the Prelude
+-- -----------------------------------------------------------------------------
+
+patchPrelude :: AProg a -> AProg a
+patchPrelude p@(AProg n _ ts fs os)
+  | n == prelude = AProg n [] ts' fs os
+  | otherwise    = p
+  where ts' = sortBy (compare `on` typeName) pts
+        pts = primTypes ++ ts
+
+primTypes :: [TypeDecl]
+primTypes =
+  [ Type arrow Public [0, 1] []
+  , Type unit Public [] [(Cons unit 0 Public [])]
+  , Type nil Public [0] [ Cons nil  0 Public []
+                        , Cons cons 2 Public [TVar 0, TCons nil [TVar 0]]
+                        ]
+  ] ++ map mkTupleType [2 .. maxTupleArity]
+  where arrow = mkPreludeQName "(->)"
+        unit  = mkPreludeQName "()"
+        nil   = mkPreludeQName "[]"
+        cons  = mkPreludeQName ":"
+
+mkTupleType :: Int -> TypeDecl
+mkTupleType arity = Type tuple Public [0 .. arity - 1]
+  [Cons tuple arity Public (map TVar [0 .. arity - 1])]
+  where tuple = mkPreludeQName $ '(' : replicate (arity - 1) ',' ++ ")"
+
+mkPreludeQName :: String -> QName
+mkPreludeQName n = (prelude, n)
+
+prelude :: String
+prelude = "Prelude"
+
+-- |Maximal arity of tuples
+maxTupleArity :: Int
+maxTupleArity = 15
+
+-- -----------------------------------------------------------------------------
+
+-- The environment 'FlatEnv' is embedded in the monadic representation
+-- 'FlatState' which allows the usage of 'do' expressions.
+type FlatState a = S.State FlatEnv a
+
+-- Data type for representing an environment which contains information needed
+-- for generating FlatCurry code.
+data FlatEnv = FlatEnv
+  { modIdent     :: ModuleIdent      -- current module
+  -- for visibility calculation
+  , tyExports    :: Set.Set Ident    -- exported types
+  , valExports   :: Set.Set Ident    -- exported values (functions + constructors)
+  , tcEnv        :: TCEnv            -- type constructor environment
+  , tyEnv        :: ValueEnv         -- type environment
+  , fixities     :: [CS.IDecl]       -- fixity declarations
+  , typeSynonyms :: [CS.Decl Type]   -- type synonyms
+  , imports      :: [ModuleIdent]    -- module imports
+  -- state for mapping identifiers to indexes
+  , nextVar      :: Int              -- fresh variable index counter
+  , varMap       :: NestEnv VarIndex -- map of identifier to variable index
+  }
+
+-- Runs a 'FlatState' action and returns the result
+run :: CompilerEnv -> CS.Module Type -> FlatState a -> a
+run env (CS.Module _ _ mid es is ds) act = S.evalState act env0
+  where
+  es'  = case es of Just (CS.Exporting _ e) -> e
+                    _                       -> []
+  env0 = FlatEnv
+    { modIdent     = mid
+     -- for visibility calculation
+    , tyExports  = foldr (buildTypeExports  mid) Set.empty es'
+    , valExports = foldr (buildValueExports mid) Set.empty es'
+    -- This includes *all* imports, even unused ones
+    , imports      = nub [ m | CS.ImportDecl _ m _ _ _ <- is ]
+    -- Environment to retrieve the type of identifiers
+    , tyEnv        = valueEnv env
+    , tcEnv        = tyConsEnv env
+    -- Fixity declarations
+    , fixities     = [ CS.IInfixDecl (spanInfo2Pos p) fix (mkPrec mPrec) (qualifyWith mid o)
+                     | CS.InfixDecl p fix mPrec os <- ds, o <- os
+                     ]
+    -- Type synonyms in the module
+    , typeSynonyms = [ d | d@CS.TypeDecl{} <- ds ]
+    , nextVar      = 0
+    , varMap       = emptyEnv
+    }
+
+-- Builds a table containing all exported identifiers from a module.
+buildTypeExports :: ModuleIdent -> CS.Export -> Set.Set Ident -> Set.Set Ident
+buildTypeExports mid (CS.ExportTypeWith _ tc _)
+  | isLocalIdent mid tc = Set.insert (unqualify tc)
+buildTypeExports _   _  = id
+
+-- Builds a table containing all exported identifiers from a module.
+buildValueExports :: ModuleIdent -> CS.Export -> Set.Set Ident -> Set.Set Ident
+buildValueExports mid (CS.Export         _     q)
+  | isLocalIdent mid q  = Set.insert (unqualify q)
+buildValueExports mid (CS.ExportTypeWith _ tc cs)
+  | isLocalIdent mid tc = flip (foldr Set.insert) cs
+buildValueExports _   _  = id
+
+getModuleIdent :: FlatState ModuleIdent
+getModuleIdent = S.gets modIdent
+
+getArity :: QualIdent -> FlatState Int
+getArity qid = S.gets tyEnv >>= \ env -> return $ case qualLookupValue qid env of
+  [DataConstructor  _ a _ _] -> a
+  [NewtypeConstructor _ _ _] -> 1
+  [Value            _ _ a _] -> a
+  [Label              _ _ _] -> 1
+  _                          ->
+    internalError ("GenTypeAnnotatedFlatCurry.getArity: " ++ qualName qid)
+
+getFixities :: FlatState [CS.IDecl]
+getFixities = S.gets fixities
+
+-- The function 'typeSynonyms' returns the list of type synonyms.
+getTypeSynonyms :: FlatState [CS.Decl Type]
+getTypeSynonyms = S.gets typeSynonyms
+
+-- Retrieve imports
+getImports :: [ModuleIdent] -> FlatState [String]
+getImports imps = (nub . map moduleName . (imps ++)) <$> S.gets imports
+
+-- -----------------------------------------------------------------------------
+-- Stateful part, used for translation of rules and expressions
+-- -----------------------------------------------------------------------------
+
+-- resets var index and environment
+withFreshEnv :: FlatState a -> FlatState a
+withFreshEnv act = S.modify (\ s -> s { nextVar = 0, varMap = emptyEnv }) >> act
+
+-- Execute an action in a nested variable mapping
+inNestedEnv :: FlatState a -> FlatState a
+inNestedEnv act = do
+  S.modify $ \ s -> s { varMap = nestEnv   $ varMap s }
+  res <- act
+  S.modify $ \ s -> s { varMap = unnestEnv $ varMap s }
+  return res
+
+-- Generates a new variable index for an identifier
+newVar :: IL.Type -> Ident -> FlatState (VarIndex, TypeExpr)
+newVar ty i = do
+  idx <- (+1) <$> S.gets nextVar
+  S.modify $ \ s -> s { nextVar = idx, varMap = bindNestEnv i idx (varMap s) }
+  ty' <- trType ty
+  return (idx, ty')
+
+-- Retrieve the variable index assigned to an identifier
+getVarIndex :: Ident -> FlatState VarIndex
+getVarIndex i = S.gets varMap >>= \ varEnv -> case lookupNestEnv i varEnv of
+  [v] -> return v
+  _   -> internalError $ "GenTypeAnnotatedFlatCurry.getVarIndex: " ++ escName i
+
+-- -----------------------------------------------------------------------------
+-- Translation of an interface
+-- -----------------------------------------------------------------------------
+
+-- Translate an operator declaration
+trIOpDecl :: CS.IDecl -> FlatState [OpDecl]
+trIOpDecl (CS.IInfixDecl _ fix prec op)
+  = (\op' -> [Op op' (cvFixity fix) prec]) <$> trQualIdent op
+trIOpDecl _ = return []
+
+-- -----------------------------------------------------------------------------
+-- Translation of a module
+-- -----------------------------------------------------------------------------
+
+trModule :: IL.Module -> FlatState (AProg TypeExpr)
+trModule (IL.Module mid is ds) = do
+  is' <- getImports is
+  sns <- getTypeSynonyms >>= concatMapM trTypeSynonym
+  tds <- concatMapM trTypeDecl ds
+  fds <- concatMapM (return . map runNormalization <=< trAFuncDecl) ds
+  ops <- getFixities >>= concatMapM trIOpDecl
+  return $ AProg (moduleName mid) is' (sns ++ tds) fds ops
+
+-- Translate a type synonym
+trTypeSynonym :: CS.Decl a -> FlatState [TypeDecl]
+trTypeSynonym (CS.TypeDecl _ t tvs ty) = do
+  m    <- getModuleIdent
+  qid  <- flip qualifyWith t <$> getModuleIdent
+  t'   <- trQualIdent qid
+  vis  <- getTypeVisibility qid
+  tEnv <- S.gets tcEnv
+  ty'  <- trType (transType $ expandType m tEnv $ toType tvs ty)
+  return [TypeSyn t' vis [0 .. length tvs - 1] ty']
+trTypeSynonym _                        = return []
+
+-- Translate a data declaration
+-- For empty data declarations, an additional constructor is generated. This
+-- is due to the fact that external data declarations are translated into data
+-- declarations with zero constructors and without the additional constructor
+-- empty data declarations could not be distinguished from external ones.
+trTypeDecl :: IL.Decl -> FlatState [TypeDecl]
+trTypeDecl (IL.DataDecl      qid a []) = do
+  q'  <- trQualIdent qid
+  vis <- getTypeVisibility qid
+  c   <- trQualIdent $ qualify (mkIdent $ "_Constr#" ++ idName (unqualify qid))
+  let tvs = [0 .. a - 1]
+  return [Type q' vis tvs [Cons c 1 Private [TCons q' $ map TVar tvs]]]
+trTypeDecl (IL.DataDecl      qid a cs) = do
+  q'  <- trQualIdent qid
+  vis <- getTypeVisibility qid
+  cs' <- mapM trConstrDecl cs
+  return [Type q' vis [0 .. a - 1] cs']
+trTypeDecl (IL.ExternalDataDecl qid a) = do
+  q'  <- trQualIdent qid
+  vis <- getTypeVisibility qid
+  return [Type q' vis [0 .. a - 1] []]
+trTypeDecl _                           = return []
+
+-- Translate a constructor declaration
+trConstrDecl :: IL.ConstrDecl -> FlatState ConsDecl
+trConstrDecl (IL.ConstrDecl qid tys) = flip Cons (length tys)
+  <$> trQualIdent qid
+  <*> getVisibility qid
+  <*> mapM trType tys
+
+-- Translate a type expression
+trType :: IL.Type -> FlatState TypeExpr
+trType (IL.TypeConstructor t tys) = TCons <$> trQualIdent t <*> mapM trType tys
+trType (IL.TypeVariable      idx) = return $ TVar $ abs idx
+trType (IL.TypeArrow     ty1 ty2) = FuncType <$> trType ty1 <*> trType ty2
+trType (IL.TypeForall    idxs ty) = ForallType (map abs idxs) <$> trType ty
+
+-- Convert a fixity
+cvFixity :: CS.Infix -> Fixity
+cvFixity CS.InfixL = InfixlOp
+cvFixity CS.InfixR = InfixrOp
+cvFixity CS.Infix  = InfixOp
+
+-- -----------------------------------------------------------------------------
+-- Function declarations
+-- -----------------------------------------------------------------------------
+
+-- Translate a function declaration
+trAFuncDecl :: IL.Decl -> FlatState [AFuncDecl TypeExpr]
+trAFuncDecl (IL.FunctionDecl f vs _ e) = do
+  f'  <- trQualIdent f
+  a   <- getArity f
+  vis <- getVisibility f
+  ty' <- trType ty
+  r'  <- trARule ty vs e
+  return [AFunc f' a vis ty' r']
+  where ty = foldr IL.TypeArrow (IL.typeOf e) $ map fst vs
+trAFuncDecl (IL.ExternalDecl     f ty) = do
+  f'   <- trQualIdent f
+  a    <- getArity f
+  vis  <- getVisibility f
+  ty'  <- trType ty
+  r'   <- trAExternal ty f
+  return [AFunc f' a vis ty' r']
+trAFuncDecl _                           = return []
+
+-- Translate a function rule.
+-- Resets variable index so that for every rule variables start with index 1
+trARule :: IL.Type -> [(IL.Type, Ident)] -> IL.Expression
+        -> FlatState (ARule TypeExpr)
+trARule ty vs e = withFreshEnv $ ARule <$> trType ty
+                                    <*> mapM (uncurry newVar) vs
+                                    <*> trAExpr e
+
+trAExternal :: IL.Type -> QualIdent -> FlatState (ARule TypeExpr)
+trAExternal ty f = flip AExternal (qualName f) <$> trType ty
+
+-- Translate an expression
+trAExpr :: IL.Expression -> FlatState (AExpr TypeExpr)
+trAExpr (IL.Literal       ty l) = ALit <$> trType ty <*> trLiteral l
+trAExpr (IL.Variable      ty v) = AVar <$> trType ty <*> getVarIndex v
+trAExpr (IL.Function    ty f _) = genCall Fun ty f []
+trAExpr (IL.Constructor ty c _) = genCall Con ty c []
+trAExpr (IL.Apply        e1 e2) = trApply e1 e2
+trAExpr c@(IL.Case      t e bs) = flip ACase (cvEval t) <$> trType (IL.typeOf c) <*> trAExpr e
+                                  <*> mapM (inNestedEnv . trAlt) bs
+trAExpr (IL.Or           e1 e2) = AOr <$> trType (IL.typeOf e1) <*> trAExpr e1 <*> trAExpr e2
+trAExpr (IL.Exist       v ty e) = inNestedEnv $ do
+  v' <- newVar ty v
+  e' <- trAExpr e
+  ty' <- trType (IL.typeOf e)
+  return $ case e' of AFree ty'' vs e'' -> AFree ty'' (v' : vs) e''
+                      _                 -> AFree ty'  (v' : []) e'
+trAExpr (IL.Let (IL.Binding v b) e) = inNestedEnv $ do
+  v' <- newVar (IL.typeOf b) v
+  b' <- trAExpr b
+  e' <- trAExpr e
+  ty' <- trType $ IL.typeOf e
+  return $ case e' of ALet ty'' bs e'' -> ALet ty'' ((v', b'):bs) e''
+                      _                -> ALet ty'  ((v', b'):[]) e'
+trAExpr (IL.Letrec   bs e) = inNestedEnv $ do
+  let (vs, es) = unzip [ ((IL.typeOf b, v), b) | IL.Binding v b <- bs]
+  ALet <$> trType (IL.typeOf e)
+       <*> (zip <$> mapM (uncurry newVar) vs <*> mapM trAExpr es)
+       <*> trAExpr e
+trAExpr (IL.Typed e _) = ATyped <$> ty' <*> trAExpr e <*> ty'
+  where ty' = trType $ IL.typeOf e
+
+-- Translate a literal
+trLiteral :: IL.Literal -> FlatState Literal
+trLiteral (IL.Char  c) = return $ Charc  c
+trLiteral (IL.Int   i) = return $ Intc   i
+trLiteral (IL.Float f) = return $ Floatc f
+
+-- Translate a higher-order application
+trApply :: IL.Expression -> IL.Expression -> FlatState (AExpr TypeExpr)
+trApply e1 e2 = genFlatApplic e1 [e2]
+  where
+  genFlatApplic e es = case e of
+    IL.Apply        ea eb -> genFlatApplic ea (eb:es)
+    IL.Function    ty f _ -> genCall Fun ty f es
+    IL.Constructor ty c _ -> genCall Con ty c es
+    _ -> do
+      expr <- trAExpr e
+      genApply expr es
+
+-- Translate an alternative
+trAlt :: IL.Alt -> FlatState (ABranchExpr TypeExpr)
+trAlt (IL.Alt p e) = ABranch <$> trPat p <*> trAExpr e
+
+-- Translate a pattern
+trPat :: IL.ConstrTerm -> FlatState (APattern TypeExpr)
+trPat (IL.LiteralPattern        ty l) = ALPattern <$> trType ty <*> trLiteral l
+trPat (IL.ConstructorPattern ty c vs) = do
+  qty <- trType $ foldr IL.TypeArrow ty $ map fst vs
+  APattern  <$> trType ty <*> ((\q -> (q, qty)) <$> trQualIdent c) <*> mapM (uncurry newVar) vs
+trPat (IL.VariablePattern        _ _) = internalError "GenTypeAnnotatedFlatCurry.trPat"
+
+-- Convert a case type
+cvEval :: IL.Eval -> CaseType
+cvEval IL.Rigid = Rigid
+cvEval IL.Flex  = Flex
+
+data Call = Fun | Con
+
+-- Generate a function or constructor call
+genCall :: Call -> IL.Type -> QualIdent -> [IL.Expression]
+        -> FlatState (AExpr TypeExpr)
+genCall call ty f es = do
+  f'    <- trQualIdent f
+  arity <- getArity f
+  case compare supplied arity of
+    LT -> genAComb ty f' es (part call (arity - supplied))
+    EQ -> genAComb ty f' es (full call)
+    GT -> do
+      let (es1, es2) = splitAt arity es
+      funccall <- genAComb ty f' es1 (full call)
+      genApply funccall es2
+  where
+  supplied = length es
+  full Fun = FuncCall
+  full Con = ConsCall
+  part Fun = FuncPartCall
+  part Con = ConsPartCall
+
+genAComb :: IL.Type -> QName -> [IL.Expression] -> CombType -> FlatState (AExpr TypeExpr)
+genAComb ty qid es ct = do
+  ty' <- trType ty
+  let ty'' = defunc ty' (length es)
+  AComb ty'' ct (qid, ty') <$> mapM trAExpr es
+  where
+  defunc t               0 = t
+  defunc (FuncType _ t2) n = defunc t2 (n - 1)
+  defunc _               _ = internalError "GenTypeAnnotatedFlatCurry.genAComb.defunc"
+
+genApply :: AExpr TypeExpr -> [IL.Expression] -> FlatState (AExpr TypeExpr)
+genApply e es = do
+  ap  <- trQualIdent $ qApplyId
+  es' <- mapM trAExpr es
+  return $ foldl (\e1 e2 -> let FuncType ty1 ty2 = typeOf e1 in AComb ty2 FuncCall (ap, FuncType (FuncType ty1 ty2) (FuncType ty1 ty2)) [e1, e2]) e es'
+
+-- -----------------------------------------------------------------------------
+-- Normalization
+-- -----------------------------------------------------------------------------
+
+runNormalization :: Normalize a => a -> a
+runNormalization x = S.evalState (normalize x) (0, Map.empty)
+
+type NormState a = S.State (Int, Map.Map Int Int) a
+
+class Normalize a where
+  normalize :: a -> NormState a
+
+instance Normalize Int where
+  normalize i = do
+    (n, m) <- S.get
+    case Map.lookup i m of
+      Nothing -> do
+        S.put (n + 1, Map.insert i n m)
+        return n
+      Just n' -> return n'
+
+instance Normalize TypeExpr where
+  normalize (TVar           i) = TVar <$> normalize i
+  normalize (TCons      q tys) = TCons q <$> mapM normalize tys
+  normalize (FuncType ty1 ty2) = FuncType <$> normalize ty1 <*> normalize ty2
+  normalize (ForallType is ty) =
+    ForallType <$> mapM normalize is <*> normalize ty
+
+instance Normalize b => Normalize (a, b) where
+  normalize (x, y) = ((,) x) <$> normalize y
+
+instance Normalize a => Normalize (AFuncDecl a) where
+  normalize (AFunc f a v ty r) = AFunc f a v <$> normalize ty <*> normalize r
+
+instance Normalize a => Normalize (ARule a) where
+  normalize (ARule     ty vs e) = ARule <$> normalize ty
+                                        <*> mapM normalize vs
+                                        <*> normalize e
+  normalize (AExternal ty    s) = flip AExternal s <$> normalize ty
+
+instance Normalize a => Normalize (AExpr a) where
+  normalize (AVar  ty       v) = flip AVar  v  <$> normalize ty
+  normalize (ALit  ty       l) = flip ALit  l  <$> normalize ty
+  normalize (AComb ty ct f es) = flip AComb ct <$> normalize ty
+                                               <*> normalize f
+                                               <*> mapM normalize es
+  normalize (ALet  ty    ds e) = ALet <$> normalize ty
+                                      <*> mapM normalizeBinding ds
+                                      <*> normalize e
+    where normalizeBinding (v, b) = (,) <$> normalize v <*> normalize b
+  normalize (AOr   ty     a b) = AOr <$> normalize ty <*> normalize a
+                                     <*> normalize b
+  normalize (ACase ty ct e bs) = flip ACase ct <$> normalize ty <*> normalize e
+                                               <*> mapM normalize bs
+  normalize (AFree  ty   vs e) = AFree <$> normalize ty <*> mapM normalize vs
+                                       <*> normalize e
+  normalize (ATyped ty  e ty') = ATyped <$> normalize ty <*> normalize e
+                                        <*> normalize ty'
+
+instance Normalize a => Normalize (ABranchExpr a) where
+  normalize (ABranch p e) = ABranch <$> normalize p <*> normalize e
+
+instance Normalize a => Normalize (APattern a) where
+  normalize (APattern  ty c vs) = APattern <$> normalize ty <*> normalize c
+                                           <*> mapM normalize vs
+  normalize (ALPattern ty    l) = flip ALPattern l <$> normalize ty
+
+-- -----------------------------------------------------------------------------
+-- Helper functions
+-- -----------------------------------------------------------------------------
+
+trQualIdent :: QualIdent -> FlatState QName
+trQualIdent qid = do
+  mid <- getModuleIdent
+  return $ (moduleName $ fromMaybe mid mid', idName i)
+  where
+  mid' | i `elem` [listId, consId, nilId, unitId] || isTupleId i
+       = Just preludeMIdent
+       | otherwise
+       = qidModule qid
+  i = qidIdent qid
+
+getTypeVisibility :: QualIdent -> FlatState Visibility
+getTypeVisibility i = S.gets $ \s ->
+  if Set.member (unqualify i) (tyExports s) then Public else Private
+
+getVisibility :: QualIdent -> FlatState Visibility
+getVisibility i = S.gets $ \s ->
+  if Set.member (unqualify i) (valExports s) then Public else Private
diff --git a/src/Generators/GenTypedFlatCurry.hs b/src/Generators/GenTypedFlatCurry.hs
--- a/src/Generators/GenTypedFlatCurry.hs
+++ b/src/Generators/GenTypedFlatCurry.hs
@@ -2,9 +2,10 @@
     Module      :  $Header$
     Description :  Generation of typed FlatCurry program terms
     Copyright   :  (c) 2017        Finn Teegen
+                       2018        Kai-Oliver Prott
     License     :  BSD-3-clause
 
-    Maintainer  :  bjp@informatik.uni-kiel.de
+    Maintainer  :  fte@informatik.uni-kiel.de
     Stability   :  experimental
     Portability :  portable
 
@@ -28,9 +29,9 @@
 import qualified Data.Set            as Set (Set, empty, insert, member)
 
 import           Curry.Base.Ident
-import           Curry.FlatCurry.Annotated.Goodies (typeName)
-import           Curry.FlatCurry.Annotated.Type
-import           Curry.FlatCurry.Annotated.Typing
+import           Curry.Base.SpanInfo
+import           Curry.FlatCurry.Typed.Goodies (typeName)
+import           Curry.FlatCurry.Typed.Type
 import qualified Curry.Syntax as CS
 
 import Base.CurryTypes     (toType)
@@ -45,21 +46,21 @@
 import Env.TypeConstructor (TCEnv)
 import Env.Value           (ValueEnv, ValueInfo (..), qualLookupValue)
 
-import qualified IL as IL
+import qualified IL
 import Transformations     (transType)
 
 -- transforms intermediate language code (IL) to typed FlatCurry code
 genTypedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-                  -> AProg TypeExpr
+                  -> TProg
 genTypedFlatCurry env mdl il = patchPrelude $ run env mdl (trModule il)
 
 -- -----------------------------------------------------------------------------
 -- Addition of primitive types for lists and tuples to the Prelude
 -- -----------------------------------------------------------------------------
 
-patchPrelude :: AProg a -> AProg a
-patchPrelude p@(AProg n _ ts fs os)
-  | n == prelude = AProg n [] ts' fs os
+patchPrelude :: TProg -> TProg
+patchPrelude p@(TProg n _ ts fs os)
+  | n == prelude = TProg n [] ts' fs os
   | otherwise    = p
   where ts' = sortBy (compare `on` typeName) pts
         pts = primTypes ++ ts
@@ -117,7 +118,7 @@
 
 -- Runs a 'FlatState' action and returns the result
 run :: CompilerEnv -> CS.Module Type -> FlatState a -> a
-run env (CS.Module _ mid es is ds) act = S.evalState act env0
+run env (CS.Module _ _ mid es is ds) act = S.evalState act env0
   where
   es'  = case es of Just (CS.Exporting _ e) -> e
                     _                       -> []
@@ -132,7 +133,7 @@
     , tyEnv        = valueEnv env
     , tcEnv        = tyConsEnv env
     -- Fixity declarations
-    , fixities     = [ CS.IInfixDecl p fix (mkPrec mPrec) (qualifyWith mid o)
+    , fixities     = [ CS.IInfixDecl (spanInfo2Pos p) fix (mkPrec mPrec) (qualifyWith mid o)
                      | CS.InfixDecl p fix mPrec os <- ds, o <- os
                      ]
     -- Type synonyms in the module
@@ -143,15 +144,15 @@
 
 -- Builds a table containing all exported identifiers from a module.
 buildTypeExports :: ModuleIdent -> CS.Export -> Set.Set Ident -> Set.Set Ident
-buildTypeExports mid (CS.ExportTypeWith tc _)
+buildTypeExports mid (CS.ExportTypeWith _ tc _)
   | isLocalIdent mid tc = Set.insert (unqualify tc)
 buildTypeExports _   _  = id
 
 -- Builds a table containing all exported identifiers from a module.
 buildValueExports :: ModuleIdent -> CS.Export -> Set.Set Ident -> Set.Set Ident
-buildValueExports mid (CS.Export             q)
+buildValueExports mid (CS.Export             _ q)
   | isLocalIdent mid q  = Set.insert (unqualify q)
-buildValueExports mid (CS.ExportTypeWith tc cs)
+buildValueExports mid (CS.ExportTypeWith _ tc cs)
   | isLocalIdent mid tc = flip (foldr Set.insert) cs
 buildValueExports _   _  = id
 
@@ -222,14 +223,14 @@
 -- Translation of a module
 -- -----------------------------------------------------------------------------
 
-trModule :: IL.Module -> FlatState (AProg TypeExpr)
+trModule :: IL.Module -> FlatState TProg
 trModule (IL.Module mid is ds) = do
   is' <- getImports is
   sns <- getTypeSynonyms >>= concatMapM trTypeSynonym
   tds <- concatMapM trTypeDecl ds
-  fds <- concatMapM (return . map runNormalization <=< trAFuncDecl) ds
+  fds <- concatMapM (return . map runNormalization <=< trTFuncDecl) ds
   ops <- getFixities >>= concatMapM trIOpDecl
-  return $ AProg (moduleName mid) is' (sns ++ tds) fds ops
+  return $ TProg (moduleName mid) is' (sns ++ tds) fds ops
 
 -- Translate a type synonym
 trTypeSynonym :: CS.Decl a -> FlatState [TypeDecl]
@@ -291,64 +292,60 @@
 -- -----------------------------------------------------------------------------
 
 -- Translate a function declaration
-trAFuncDecl :: IL.Decl -> FlatState [AFuncDecl TypeExpr]
-trAFuncDecl (IL.FunctionDecl f vs _ e) = do
+trTFuncDecl :: IL.Decl -> FlatState [TFuncDecl]
+trTFuncDecl (IL.FunctionDecl f vs _ e) = do
   f'  <- trQualIdent f
   a   <- getArity f
   vis <- getVisibility f
   ty' <- trType ty
-  r'  <- trARule ty vs e
-  return [AFunc f' a vis ty' r']
+  r'  <- trTRule vs e
+  return [TFunc f' a vis ty' r']
   where ty = foldr IL.TypeArrow (IL.typeOf e) $ map fst vs
-trAFuncDecl (IL.ExternalDecl     f ty) = do
+trTFuncDecl (IL.ExternalDecl     f ty) = do
   f'   <- trQualIdent f
   a    <- getArity f
   vis  <- getVisibility f
   ty'  <- trType ty
-  r'   <- trAExternal ty f
-  return [AFunc f' a vis ty' r']
-trAFuncDecl _                           = return []
+  r'   <- trTExternal ty f
+  return [TFunc f' a vis ty' r']
+trTFuncDecl _                           = return []
 
 -- Translate a function rule.
 -- Resets variable index so that for every rule variables start with index 1
-trARule :: IL.Type -> [(IL.Type, Ident)] -> IL.Expression
-        -> FlatState (ARule TypeExpr)
-trARule ty vs e = withFreshEnv $ ARule <$> trType ty
-                                    <*> mapM (uncurry newVar) vs
-                                    <*> trAExpr e
+trTRule :: [(IL.Type, Ident)] -> IL.Expression
+        -> FlatState TRule
+trTRule vs e = withFreshEnv $ TRule <$> mapM (uncurry newVar) vs
+                                    <*> trTExpr e
 
-trAExternal :: IL.Type -> QualIdent -> FlatState (ARule TypeExpr)
-trAExternal ty f = flip AExternal (qualName f) <$> trType ty
+trTExternal :: IL.Type -> QualIdent -> FlatState TRule
+trTExternal ty f = flip TExternal (qualName f) <$> trType ty
 
 -- Translate an expression
-trAExpr :: IL.Expression -> FlatState (AExpr TypeExpr)
-trAExpr (IL.Literal       ty l) = ALit <$> trType ty <*> trLiteral l
-trAExpr (IL.Variable      ty v) = AVar <$> trType ty <*> getVarIndex v
-trAExpr (IL.Function    ty f _) = genCall Fun ty f []
-trAExpr (IL.Constructor ty c _) = genCall Con ty c []
-trAExpr (IL.Apply        e1 e2) = trApply e1 e2
-trAExpr c@(IL.Case      t e bs) = flip ACase (cvEval t) <$> trType (IL.typeOf c) <*> trAExpr e
+trTExpr :: IL.Expression -> FlatState TExpr
+trTExpr (IL.Literal       ty l) = TLit  <$> trType ty <*> trLiteral l
+trTExpr (IL.Variable      ty v) = TVarE <$> trType ty <*> getVarIndex v
+trTExpr (IL.Function    ty f _) = genCall Fun ty f []
+trTExpr (IL.Constructor ty c _) = genCall Con ty c []
+trTExpr (IL.Apply        e1 e2) = trApply e1 e2
+trTExpr (IL.Case        t e bs) = TCase (cvEval t) <$> trTExpr e
                                   <*> mapM (inNestedEnv . trAlt) bs
-trAExpr (IL.Or           e1 e2) = AOr <$> trType (IL.typeOf e1) <*> trAExpr e1 <*> trAExpr e2
-trAExpr (IL.Exist          v e) = inNestedEnv $ do
-  v' <- newVar (IL.typeOf e) v
-  e' <- trAExpr e
-  ty' <- trType (IL.typeOf e)
-  return $ case e' of AFree ty'' vs e'' -> AFree ty'' (v' : vs) e''
-                      _                 -> AFree ty'  (v' : []) e'
-trAExpr (IL.Let (IL.Binding v b) e) = inNestedEnv $ do
+trTExpr (IL.Or           e1 e2) = TOr <$> trTExpr e1 <*> trTExpr e2
+trTExpr (IL.Exist       v ty e) = inNestedEnv $ do
+  v' <- newVar ty v
+  e' <- trTExpr e
+  return $ case e' of TFree vs e'' -> TFree (v' : vs) e''
+                      _            -> TFree (v' : []) e'
+trTExpr (IL.Let (IL.Binding v b) e) = inNestedEnv $ do
   v' <- newVar (IL.typeOf b) v
-  b' <- trAExpr b
-  e' <- trAExpr e
-  ty' <- trType $ IL.typeOf e
-  return $ case e' of ALet ty'' bs e'' -> ALet ty'' ((v', b'):bs) e''
-                      _                -> ALet ty'  ((v', b'):[]) e'
-trAExpr (IL.Letrec   bs e) = inNestedEnv $ do
+  b' <- trTExpr b
+  e' <- trTExpr e
+  return $ case e' of TLet bs e'' -> TLet ((v', b'):bs) e''
+                      _           -> TLet ((v', b'):[]) e'
+trTExpr (IL.Letrec   bs e) = inNestedEnv $ do
   let (vs, es) = unzip [ ((IL.typeOf b, v), b) | IL.Binding v b <- bs]
-  ALet <$> trType (IL.typeOf e)
-       <*> (zip <$> mapM (uncurry newVar) vs <*> mapM trAExpr es)
-       <*> trAExpr e
-trAExpr (IL.Typed e _) = ATyped <$> ty' <*> trAExpr e <*> ty'
+  TLet <$> (zip <$> mapM (uncurry newVar) vs <*> mapM trTExpr es)
+       <*> trTExpr e
+trTExpr (IL.Typed e _) = TTyped <$> trTExpr e <*> ty'
   where ty' = trType $ IL.typeOf e
 
 -- Translate a literal
@@ -358,7 +355,7 @@
 trLiteral (IL.Float f) = return $ Floatc f
 
 -- Translate a higher-order application
-trApply :: IL.Expression -> IL.Expression -> FlatState (AExpr TypeExpr)
+trApply :: IL.Expression -> IL.Expression -> FlatState TExpr
 trApply e1 e2 = genFlatApplic e1 [e2]
   where
   genFlatApplic e es = case e of
@@ -366,19 +363,18 @@
     IL.Function    ty f _ -> genCall Fun ty f es
     IL.Constructor ty c _ -> genCall Con ty c es
     _ -> do
-      expr <- trAExpr e
+      expr <- trTExpr e
       genApply expr es
 
 -- Translate an alternative
-trAlt :: IL.Alt -> FlatState (ABranchExpr TypeExpr)
-trAlt (IL.Alt p e) = ABranch <$> trPat p <*> trAExpr e
+trAlt :: IL.Alt -> FlatState TBranchExpr
+trAlt (IL.Alt p e) = TBranch <$> trPat p <*> trTExpr e
 
 -- Translate a pattern
-trPat :: IL.ConstrTerm -> FlatState (APattern TypeExpr)
-trPat (IL.LiteralPattern        ty l) = ALPattern <$> trType ty <*> trLiteral l
-trPat (IL.ConstructorPattern ty c vs) = do
-  qty <- trType $ foldr IL.TypeArrow ty $ map fst vs
-  APattern  <$> trType ty <*> ((\q -> (q, qty)) <$> trQualIdent c) <*> mapM (uncurry newVar) vs
+trPat :: IL.ConstrTerm -> FlatState TPattern
+trPat (IL.LiteralPattern        ty l) = TLPattern <$> trType ty <*> trLiteral l
+trPat (IL.ConstructorPattern ty c vs) =
+  TPattern <$> trType ty <*> trQualIdent c <*> mapM (uncurry newVar) vs
 trPat (IL.VariablePattern        _ _) = internalError "GenTypedFlatCurry.trPat"
 
 -- Convert a case type
@@ -390,16 +386,16 @@
 
 -- Generate a function or constructor call
 genCall :: Call -> IL.Type -> QualIdent -> [IL.Expression]
-        -> FlatState (AExpr TypeExpr)
+        -> FlatState TExpr
 genCall call ty f es = do
   f'    <- trQualIdent f
   arity <- getArity f
   case compare supplied arity of
-    LT -> genAComb ty f' es (part call (arity - supplied))
-    EQ -> genAComb ty f' es (full call)
+    LT -> genTComb ty f' es (part call (arity - supplied))
+    EQ -> genTComb ty f' es (full call)
     GT -> do
       let (es1, es2) = splitAt arity es
-      funccall <- genAComb ty f' es1 (full call)
+      funccall <- genTComb ty f' es1 (full call)
       genApply funccall es2
   where
   supplied = length es
@@ -408,21 +404,23 @@
   part Fun = FuncPartCall
   part Con = ConsPartCall
 
-genAComb :: IL.Type -> QName -> [IL.Expression] -> CombType -> FlatState (AExpr TypeExpr)
-genAComb ty qid es ct = do
+genTComb :: IL.Type -> QName -> [IL.Expression] -> CombType -> FlatState TExpr
+genTComb ty qid es ct = do
   ty' <- trType ty
   let ty'' = defunc ty' (length es)
-  AComb ty'' ct (qid, ty') <$> mapM trAExpr es
+  TComb ty'' ct qid <$> mapM trTExpr es
   where
   defunc t               0 = t
   defunc (FuncType _ t2) n = defunc t2 (n - 1)
-  defunc _               _ = internalError "GenTypedFlatCurry.genAComb.defunc"
+  defunc _               _ = internalError "GenTypedFlatCurry.genTComb.defunc"
 
-genApply :: AExpr TypeExpr -> [IL.Expression] -> FlatState (AExpr TypeExpr)
+genApply :: TExpr -> [IL.Expression] -> FlatState TExpr
 genApply e es = do
-  ap  <- trQualIdent $ qApplyId
-  es' <- mapM trAExpr es
-  return $ foldl (\e1 e2 -> let FuncType ty1 ty2 = typeOf e1 in AComb ty2 FuncCall (ap, FuncType (FuncType ty1 ty2) (FuncType ty1 ty2)) [e1, e2]) e es'
+  ap  <- trQualIdent qApplyId
+  es' <- mapM trTExpr es
+  return $ foldl (\e1 e2 -> let FuncType _ ty2 = typeOf e1
+                            in TComb ty2 FuncCall ap [e1, e2])
+             e es'
 
 -- -----------------------------------------------------------------------------
 -- Normalization
@@ -453,43 +451,42 @@
     ForallType <$> mapM normalize is <*> normalize ty
 
 instance Normalize b => Normalize (a, b) where
-  normalize (x, y) = ((,) x) <$> normalize y
+  normalize (x, y) = (,) x <$> normalize y
 
-instance Normalize a => Normalize (AFuncDecl a) where
-  normalize (AFunc f a v ty r) = AFunc f a v <$> normalize ty <*> normalize r
+instance Normalize TFuncDecl where
+  normalize (TFunc f a v ty r) = TFunc f a v <$> normalize ty <*> normalize r
 
-instance Normalize a => Normalize (ARule a) where
-  normalize (ARule     ty vs e) = ARule <$> normalize ty
-                                        <*> mapM normalize vs
+instance Normalize TRule where
+  normalize (TRule        vs e) = TRule <$> mapM normalize vs
                                         <*> normalize e
-  normalize (AExternal ty    s) = flip AExternal s <$> normalize ty
+  normalize (TExternal ty    s) = flip TExternal s <$> normalize ty
 
-instance Normalize a => Normalize (AExpr a) where
-  normalize (AVar  ty       v) = flip AVar  v  <$> normalize ty
-  normalize (ALit  ty       l) = flip ALit  l  <$> normalize ty
-  normalize (AComb ty ct f es) = flip AComb ct <$> normalize ty
-                                               <*> normalize f
-                                               <*> mapM normalize es
-  normalize (ALet  ty    ds e) = ALet <$> normalize ty
-                                      <*> mapM normalizeBinding ds
+instance Normalize TExpr where
+  normalize (TVarE  ty       v) = flip TVarE  v <$> normalize ty
+  normalize (TLit   ty       l) = flip TLit  l  <$> normalize ty
+  normalize (TComb  ty ct f es) = flip TComb ct <$> normalize ty
+                                                <*> pure f
+                                                <*> mapM normalize es
+  normalize (TLet        ds e) = TLet <$> mapM normalizeBinding ds
                                       <*> normalize e
     where normalizeBinding (v, b) = (,) <$> normalize v <*> normalize b
-  normalize (AOr   ty     a b) = AOr <$> normalize ty <*> normalize a
+  normalize (TOr          a b) = TOr <$> normalize a
                                      <*> normalize b
-  normalize (ACase ty ct e bs) = flip ACase ct <$> normalize ty <*> normalize e
-                                               <*> mapM normalize bs
-  normalize (AFree  ty   vs e) = AFree <$> normalize ty <*> mapM normalize vs
+  normalize (TCase    ct e bs) = TCase ct <$> normalize e
+                                          <*> mapM normalize bs
+  normalize (TFree       vs e) = TFree <$> mapM normalize vs
                                        <*> normalize e
-  normalize (ATyped ty  e ty') = ATyped <$> normalize ty <*> normalize e
+  normalize (TTyped     e ty') = TTyped <$> normalize e
                                         <*> normalize ty'
 
-instance Normalize a => Normalize (ABranchExpr a) where
-  normalize (ABranch p e) = ABranch <$> normalize p <*> normalize e
+instance Normalize TBranchExpr where
+  normalize (TBranch p e) = TBranch <$> normalize p <*> normalize e
 
-instance Normalize a => Normalize (APattern a) where
-  normalize (APattern  ty c vs) = APattern <$> normalize ty <*> normalize c
+instance Normalize TPattern where
+  normalize (TPattern  ty c vs) = TPattern <$> normalize ty
+                                           <*> pure c
                                            <*> mapM normalize vs
-  normalize (ALPattern ty    l) = flip ALPattern l <$> normalize ty
+  normalize (TLPattern ty    l) = flip TLPattern l <$> normalize ty
 
 -- -----------------------------------------------------------------------------
 -- Helper functions
diff --git a/src/Html/SyntaxColoring.hs b/src/Html/SyntaxColoring.hs
--- a/src/Html/SyntaxColoring.hs
+++ b/src/Html/SyntaxColoring.hs
@@ -40,6 +40,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo ()
 import Curry.Syntax
 
 import Base.Messages
@@ -242,28 +243,11 @@
 pragmaCategories :: [Category]
 pragmaCategories = [PragmaLanguage, PragmaOptions, PragmaEnd]
 
--- DECL Position
-
-declPos :: Decl a -> Position
-declPos (InfixDecl        p _ _ _    ) = p
-declPos (DataDecl         p _ _ _ _  ) = p
-declPos (ExternalDataDecl p _ _      ) = p
-declPos (NewtypeDecl      p _ _ _ _  ) = p
-declPos (TypeDecl         p _ _ _    ) = p
-declPos (TypeSig          p _ _      ) = p
-declPos (FunctionDecl     p _ _ _    ) = p
-declPos (ExternalDecl     p _        ) = p
-declPos (PatternDecl      p _ _      ) = p
-declPos (FreeDecl         p _        ) = p
-declPos (DefaultDecl      p _        ) = p
-declPos (ClassDecl        p _ _ _ _  ) = p
-declPos (InstanceDecl     p _ _ _ _  ) = p
-
 cmpDecl :: Decl a -> Decl a -> Ordering
-cmpDecl = compare `on` declPos
+cmpDecl = compare `on` getPosition
 
 cmpImportDecl :: ImportDecl -> ImportDecl -> Ordering
-cmpImportDecl = compare `on` (\ (ImportDecl p _ _ _ _) -> p)
+cmpImportDecl = compare `on` getPosition
 
 -- -----------------------------------------------------------------------------
 -- Extract all identifiers mentioned in the source code as a Code entity
@@ -273,7 +257,7 @@
 -- -----------------------------------------------------------------------------
 
 idsModule :: Module a -> [Code]
-idsModule (Module _ mid es is ds) =
+idsModule (Module _ _ mid es is ds) =
   let hdrCodes = ModuleName mid : idsExportSpec es
       impCodes = concatMap idsImportDecl (sortBy cmpImportDecl is)
       dclCodes = concatMap idsDecl       (sortBy cmpDecl ds)
@@ -286,11 +270,11 @@
 idsExportSpec (Just (Exporting _ es)) = concatMap idsExport es
 
 idsExport :: Export -> [Code]
-idsExport (Export            qid) = [Function FuncExport False qid]
-idsExport (ExportTypeWith qid cs) = TypeCons TypeExport False qid :
+idsExport (Export            _ qid) = [Function FuncExport False qid]
+idsExport (ExportTypeWith _ qid cs) = TypeCons TypeExport False qid :
   map (DataCons ConsExport False . qualify) cs
-idsExport (ExportTypeAll     qid) = [TypeCons TypeExport False qid]
-idsExport (ExportModule      mid) = [ModuleName mid]
+idsExport (ExportTypeAll     _ qid) = [TypeCons TypeExport False qid]
+idsExport (ExportModule      _ mid) = [ModuleName mid]
 
 -- Imports
 
@@ -304,12 +288,12 @@
 idsImportSpec mid (Hiding    _ is) = concatMap (idsImport mid) is
 
 idsImport :: ModuleIdent -> Import -> [Code]
-idsImport mid (Import            i) =
+idsImport mid (Import            _ i) =
   [Function FuncImport False $ qualifyWith mid i]
-idsImport mid (ImportTypeWith t cs) =
+idsImport mid (ImportTypeWith _ t cs) =
   TypeCons TypeImport False (qualifyWith mid t) :
     map (DataCons ConsImport False . qualifyWith mid) cs
-idsImport mid (ImportTypeAll     t) =
+idsImport mid (ImportTypeAll     _ t) =
   [TypeCons TypeImport False $ qualifyWith mid t]
 
 -- Declarations
@@ -377,24 +361,24 @@
   internalError "SyntaxColoring.idsInstanceDecl"
 
 idsQualTypeExpr :: QualTypeExpr -> [Code]
-idsQualTypeExpr (QualTypeExpr cx ty) = idsContext cx ++ idsTypeExpr ty
+idsQualTypeExpr (QualTypeExpr _ cx ty) = idsContext cx ++ idsTypeExpr ty
 
 idsContext :: Context -> [Code]
 idsContext = concatMap idsConstraint
 
 idsConstraint :: Constraint -> [Code]
-idsConstraint (Constraint qcls ty) =
+idsConstraint (Constraint _ qcls ty) =
   TypeCons TypeRefer False qcls : idsTypeExpr ty
 
 idsTypeExpr :: TypeExpr -> [Code]
-idsTypeExpr (ConstructorType qid) = [TypeCons TypeRefer False qid]
-idsTypeExpr (ApplyType   ty1 ty2) = concatMap idsTypeExpr [ty1, ty2]
-idsTypeExpr (VariableType      v) = [Identifier IdRefer False (qualify v)]
-idsTypeExpr (TupleType       tys) = concatMap idsTypeExpr tys
-idsTypeExpr (ListType         ty) = idsTypeExpr ty
-idsTypeExpr (ArrowType   ty1 ty2) = concatMap idsTypeExpr [ty1, ty2]
-idsTypeExpr (ParenType        ty) = idsTypeExpr ty
-idsTypeExpr (ForallType    vs ty) =
+idsTypeExpr (ConstructorType _ qid) = [TypeCons TypeRefer False qid]
+idsTypeExpr (ApplyType   _ ty1 ty2) = concatMap idsTypeExpr [ty1, ty2]
+idsTypeExpr (VariableType      _ v) = [Identifier IdRefer False (qualify v)]
+idsTypeExpr (TupleType       _ tys) = concatMap idsTypeExpr tys
+idsTypeExpr (ListType         _ ty) = idsTypeExpr ty
+idsTypeExpr (ArrowType   _ ty1 ty2) = concatMap idsTypeExpr [ty1, ty2]
+idsTypeExpr (ParenType        _ ty) = idsTypeExpr ty
+idsTypeExpr (ForallType    _ vs ty) =
   map (Identifier IdDeclare False . qualify) vs ++ idsTypeExpr ty
 
 idsFieldDecl :: FieldDecl -> [Code]
@@ -405,69 +389,70 @@
 idsEquation (Equation _ lhs rhs) = idsLhs lhs ++ idsRhs rhs
 
 idsLhs :: Lhs a -> [Code]
-idsLhs (FunLhs    f ps) = Function FuncDeclare False (qualify f) : concatMap idsPat ps
-idsLhs (OpLhs p1 op p2) = idsPat p1 ++ [Function FuncDeclare False $ qualify op]
-                                    ++ idsPat p2
-idsLhs (ApLhs   lhs ps) = idsLhs lhs ++ concatMap idsPat ps
+idsLhs (FunLhs    _ f ps) =
+  Function FuncDeclare False (qualify f) : concatMap idsPat ps
+idsLhs (OpLhs _ p1 op p2) =
+  idsPat p1 ++ [Function FuncDeclare False $ qualify op] ++ idsPat p2
+idsLhs (ApLhs   _ lhs ps) = idsLhs lhs ++ concatMap idsPat ps
 
 idsRhs :: Rhs a -> [Code]
-idsRhs (SimpleRhs _ e ds) = idsExpr e ++ concatMap idsDecl ds
-idsRhs (GuardedRhs ce ds) = concatMap idsCondExpr ce ++ concatMap idsDecl ds
+idsRhs (SimpleRhs  _ e  ds) = idsExpr e ++ concatMap idsDecl ds
+idsRhs (GuardedRhs _ ce ds) = concatMap idsCondExpr ce ++ concatMap idsDecl ds
 
 idsCondExpr :: CondExpr a -> [Code]
 idsCondExpr (CondExpr _ e1 e2) = idsExpr e1 ++ idsExpr e2
 
 idsPat :: Pattern a -> [Code]
-idsPat (LiteralPattern          _ _) = []
-idsPat (NegativePattern         _ _) = []
-idsPat (VariablePattern         _ v) = [Identifier IdDeclare False (qualify v)]
-idsPat (ConstructorPattern _ qid ps) =
+idsPat (LiteralPattern          _ _ _) = []
+idsPat (NegativePattern         _ _ _) = []
+idsPat (VariablePattern         _ _ v) = [Identifier IdDeclare False (qualify v)]
+idsPat (ConstructorPattern _ _ qid ps) =
   DataCons ConsPattern False qid : concatMap idsPat ps
-idsPat (InfixPattern    _ p1 qid p2) =
+idsPat (InfixPattern    _ _ p1 qid p2) =
   idsPat p1 ++ DataCons ConsPattern False qid : idsPat p2
-idsPat (ParenPattern              p) = idsPat p
-idsPat (RecordPattern      _ qid fs) =
+idsPat (ParenPattern              _ p) = idsPat p
+idsPat (RecordPattern      _ _ qid fs) =
   DataCons ConsPattern False qid : concatMap (idsField idsPat) fs
-idsPat (TuplePattern            ps) = concatMap idsPat ps
-idsPat (ListPattern            _ ps) = concatMap idsPat ps
-idsPat (AsPattern               v p) =
+idsPat (TuplePattern            _ ps) = concatMap idsPat ps
+idsPat (ListPattern            _ _ ps) = concatMap idsPat ps
+idsPat (AsPattern               _ v p) =
   Identifier IdDeclare False (qualify v) : idsPat p
-idsPat (LazyPattern               p) = idsPat p
-idsPat (FunctionPattern    _ qid ps) =
+idsPat (LazyPattern               _ p) = idsPat p
+idsPat (FunctionPattern    _ _ qid ps) =
   Function FuncCall False qid : concatMap idsPat ps
-idsPat (InfixFuncPattern  _ p1 f p2) =
+idsPat (InfixFuncPattern  _ _ p1 f p2) =
   idsPat p1 ++ Function FuncInfix False f : idsPat p2
 
 idsExpr :: Expression a -> [Code]
-idsExpr (Literal              _ _) = []
-idsExpr (Variable           _ qid)
+idsExpr (Literal              _ _ _) = []
+idsExpr (Variable           _ _ qid)
   | isQualified qid                = [Function FuncCall False qid]
   | hasGlobalScope (unqualify qid) = [Function FuncCall False qid]
   | otherwise                      = [Identifier IdRefer False qid]
-idsExpr (Constructor        _ qid) = [DataCons ConsCall False qid]
-idsExpr (Paren                  e) = idsExpr e
-idsExpr (Typed              e qty) = idsExpr e ++ idsQualTypeExpr qty
-idsExpr (Record          _ qid fs) =
+idsExpr (Constructor        _ _ qid) = [DataCons ConsCall False qid]
+idsExpr (Paren                  _ e) = idsExpr e
+idsExpr (Typed              _ e qty) = idsExpr e ++ idsQualTypeExpr qty
+idsExpr (Record          _ _ qid fs) =
   DataCons ConsCall False qid : concatMap (idsField idsExpr) fs
-idsExpr (RecordUpdate        e fs) =
+idsExpr (RecordUpdate        _ e fs) =
   idsExpr e ++ concatMap (idsField idsExpr) fs
-idsExpr (Tuple                 es) = concatMap idsExpr es
-idsExpr (List                _ es) = concatMap idsExpr es
-idsExpr (ListCompr        e stmts) = idsExpr e ++ concatMap idsStmt stmts
-idsExpr (EnumFrom               e) = idsExpr e
-idsExpr (EnumFromThen       e1 e2) = concatMap idsExpr [e1, e2]
-idsExpr (EnumFromTo         e1 e2) = concatMap idsExpr [e1, e2]
-idsExpr (EnumFromThenTo  e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
-idsExpr (UnaryMinus             e) = Symbol "-" : idsExpr e
-idsExpr (Apply              e1 e2) = idsExpr e1 ++ idsExpr e2
-idsExpr (InfixApply      e1 op e2) = idsExpr e1 ++ idsInfix op ++ idsExpr e2
-idsExpr (LeftSection         e op) = idsExpr e ++ idsInfix op
-idsExpr (RightSection        op e) = idsInfix op ++ idsExpr e
-idsExpr (Lambda              ps e) = concatMap idsPat ps ++ idsExpr e
-idsExpr (Let                 ds e) = concatMap idsDecl ds ++ idsExpr e
-idsExpr (Do               stmts e) = concatMap idsStmt stmts ++ idsExpr e
-idsExpr (IfThenElse      e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
-idsExpr (Case            _ e alts) = idsExpr e ++ concatMap idsAlt alts
+idsExpr (Tuple                 _ es) = concatMap idsExpr es
+idsExpr (List                _ _ es) = concatMap idsExpr es
+idsExpr (ListCompr        _ e stmts) = idsExpr e ++ concatMap idsStmt stmts
+idsExpr (EnumFrom               _ e) = idsExpr e
+idsExpr (EnumFromThen       _ e1 e2) = concatMap idsExpr [e1, e2]
+idsExpr (EnumFromTo         _ e1 e2) = concatMap idsExpr [e1, e2]
+idsExpr (EnumFromThenTo  _ e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
+idsExpr (UnaryMinus             _ e) = Symbol "-" : idsExpr e
+idsExpr (Apply              _ e1 e2) = idsExpr e1 ++ idsExpr e2
+idsExpr (InfixApply      _ e1 op e2) = idsExpr e1 ++ idsInfix op ++ idsExpr e2
+idsExpr (LeftSection         _ e op) = idsExpr e ++ idsInfix op
+idsExpr (RightSection        _ op e) = idsInfix op ++ idsExpr e
+idsExpr (Lambda              _ ps e) = concatMap idsPat ps ++ idsExpr e
+idsExpr (Let                 _ ds e) = concatMap idsDecl ds ++ idsExpr e
+idsExpr (Do               _ stmts e) = concatMap idsStmt stmts ++ idsExpr e
+idsExpr (IfThenElse      _ e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
+idsExpr (Case            _ _ e alts) = idsExpr e ++ concatMap idsAlt alts
 
 idsField :: (a -> [Code]) -> Field a -> [Code]
 idsField f (Field _ l x) = Function FuncCall False l : f x
@@ -477,9 +462,9 @@
 idsInfix (InfixConstr _ qid) = [DataCons ConsInfix False qid]
 
 idsStmt :: Statement a -> [Code]
-idsStmt (StmtExpr   e) = idsExpr e
-idsStmt (StmtDecl  ds) = concatMap idsDecl ds
-idsStmt (StmtBind p e) = idsPat p ++ idsExpr e
+idsStmt (StmtExpr   _ e) = idsExpr e
+idsStmt (StmtDecl  _ ds) = concatMap idsDecl ds
+idsStmt (StmtBind _ p e) = idsPat p ++ idsExpr e
 
 idsAlt :: Alt a -> [Code]
 idsAlt (Alt _ p rhs) = idsPat p ++ idsRhs rhs
diff --git a/src/IL/Pretty.hs b/src/IL/Pretty.hs
--- a/src/IL/Pretty.hs
+++ b/src/IL/Pretty.hs
@@ -16,9 +16,13 @@
    printer which, in turn, is based on Simon Marlow's pretty printer
    for Haskell.
 -}
-
+{-# LANGUAGE CPP #-}
 module IL.Pretty (ppModule) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 import Curry.Base.Ident
 import Curry.Base.Pretty
 import IL.Type
@@ -139,7 +143,7 @@
         ppEval Flex  = text "flex"
 ppExpr p (Or          e1 e2) = parenIf (p > 0) $ sep
   [nest orIndent (ppExpr 0 e1), char '|', nest orIndent (ppExpr 0 e2)]
-ppExpr p (Exist         v e) = parenIf (p > 0) $ sep
+ppExpr p (Exist       v _ e) = parenIf (p > 0) $ sep
   [text "let" <+> ppIdent v <+> text "free" <+> text "in", ppExpr 0 e]
 ppExpr p (Let           b e) = parenIf (p > 0) $ sep
   [text "let" <+> ppBinding b <+> text "in",ppExpr 0 e]
diff --git a/src/IL/ShowModule.hs b/src/IL/ShowModule.hs
--- a/src/IL/ShowModule.hs
+++ b/src/IL/ShowModule.hs
@@ -156,9 +156,10 @@
   . showsExpression exp1 . space
   . showsExpression exp2
   . showsString ")"
-showsExpression (Exist ident expr)
+showsExpression (Exist ident ty expr)
   = showsString "(Exist "
   . showsIdent ident . space
+  . showsType ty . space
   . showsExpression expr
   . showsString ")"
 showsExpression (Let bind expr)
@@ -224,12 +225,12 @@
   = showsString "(" . sa a . showsString "," . sb b . showsString ")"
 
 showsIdent :: Ident -> ShowS
-showsIdent (Ident p x n)
-  = showsString "(Ident " . showsPosition p . space
+showsIdent (Ident spi x n)
+  = showsString "(Ident " . showsPosition (getPosition spi) . space
   . shows x . space . shows n . showsString ")"
 
 showsQualIdent :: QualIdent -> ShowS
-showsQualIdent (QualIdent mident ident)
+showsQualIdent (QualIdent _ mident ident)
   = showsString "(QualIdent "
   . showsMaybe showsModuleIdent mident
   . space
@@ -237,9 +238,9 @@
   . showsString ")"
 
 showsModuleIdent :: ModuleIdent -> ShowS
-showsModuleIdent (ModuleIdent pos ss)
+showsModuleIdent (ModuleIdent spi ss)
   = showsString "(ModuleIdent "
-  . showsPosition pos . space
+  . showsPosition (getPosition spi) . space
   . showsList (showsQuotes showsString) ss
   . showsString ")"
 
diff --git a/src/IL/Type.hs b/src/IL/Type.hs
--- a/src/IL/Type.hs
+++ b/src/IL/Type.hs
@@ -102,7 +102,7 @@
     -- |non-deterministic or
   | Or Expression Expression
     -- |exist binding (introduction of a free variable)
-  | Exist Ident Expression
+  | Exist Ident Type Expression
     -- |let binding
   | Let Binding Expression
     -- |letrec binding
@@ -127,7 +127,7 @@
   fv (Apply           e1 e2) = fv e1 ++ fv e2
   fv (Case         _ e alts) = fv e  ++ fv alts
   fv (Or              e1 e2) = fv e1 ++ fv e2
-  fv (Exist             v e) = filter (/= v) (fv e)
+  fv (Exist           v _ e) = filter (/= v) (fv e)
   fv (Let (Binding v e1) e2) = fv e1 ++ filter (/= v) (fv e2)
   fv (Letrec          bds e) = filter (`notElem` vs) (fv es ++ fv e)
     where (vs, es) = unzip [(v, e') | Binding v e' <- bds]
diff --git a/src/IL/Typing.hs b/src/IL/Typing.hs
--- a/src/IL/Typing.hs
+++ b/src/IL/Typing.hs
@@ -35,7 +35,7 @@
     _ -> internalError "IL.Typing.typeOf: application"
   typeOf (Case _ _ as) = typeOf $ head as
   typeOf (Or e _) = typeOf e
-  typeOf (Exist _ e) = typeOf e
+  typeOf (Exist _ _ e) = typeOf e
   typeOf (Let _ e) = typeOf e
   typeOf (Letrec _ e) = typeOf e
   typeOf (Typed e _) = typeOf e
diff --git a/src/Imports.hs b/src/Imports.hs
--- a/src/Imports.hs
+++ b/src/Imports.hs
@@ -23,6 +23,7 @@
 import qualified Data.Set            as Set
 
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Base.Monad
 import Curry.Syntax
 
@@ -48,7 +49,7 @@
 
 importModules :: Monad m => Module a -> InterfaceEnv -> [ImportDecl]
               -> CYT m CompilerEnv
-importModules mdl@(Module _ mid _ _ _) iEnv expImps
+importModules mdl@(Module _ _ mid _ _ _) iEnv expImps
   = ok $ foldl importModule initEnv expImps
   where
     initEnv = (initCompilerEnv mid)
@@ -113,14 +114,14 @@
   vs = isVisible addValue is
 
 addType :: Import -> [Ident] -> [Ident]
-addType (Import            _) tcs = tcs
-addType (ImportTypeWith tc _) tcs = tc : tcs
-addType (ImportTypeAll     _) _   = internalError "Imports.addType"
+addType (Import            _ _) tcs = tcs
+addType (ImportTypeWith _ tc _) tcs = tc : tcs
+addType (ImportTypeAll     _ _) _   = internalError "Imports.addType"
 
 addValue :: Import -> [Ident] -> [Ident]
-addValue (Import            f) fs = f : fs
-addValue (ImportTypeWith _ cs) fs = cs ++ fs
-addValue (ImportTypeAll     _) _  = internalError "Imports.addValue"
+addValue (Import            _ f) fs = f : fs
+addValue (ImportTypeWith _ _ cs) fs = cs ++ fs
+addValue (ImportTypeAll     _ _) _  = internalError "Imports.addValue"
 
 isVisible :: (Import -> [Ident] -> [Ident]) -> Maybe ImportSpec
           -> Ident -> Bool
@@ -165,7 +166,7 @@
   bindClass m (IClassDecl p cx cls k tv [] [])
 bindClass m (IClassDecl _ cx cls _ _ ds _) =
   bindClassInfo (qualQualify m cls) (sclss, ms)
-  where sclss = map (\(Constraint scls _) -> qualQualify m scls) cx
+  where sclss = map (\(Constraint _ scls _) -> qualQualify m scls) cx
         ms = map (\d -> (imethod d, isJust $ imethodArity d)) ds
 bindClass _ _ = id
 
@@ -175,7 +176,7 @@
 bindInstance :: ModuleIdent -> IDecl -> InstEnv -> InstEnv
 bindInstance m (IInstanceDecl _ cx qcls ty is mm) = bindInstInfo
   (qualQualify m qcls, qualifyTC m $ typeConstr ty) (fromMaybe m mm, ps, is)
-  where PredType ps _ = toQualPredType m [] $ QualTypeExpr cx ty
+  where PredType ps _ = toQualPredType m [] $ QualTypeExpr NoSpanInfo cx ty
 bindInstance _ _ = id
 
 -- ---------------------------------------------------------------------------
@@ -305,7 +306,7 @@
 recLabel m tc tvs ty0 (l, cs, lty) = Label ql qcs tySc
   where ql   = qualifyLike tc l
         qcs  = map (qualifyLike tc) cs
-        tySc = polyType (toQualType m tvs (ArrowType ty0 lty))
+        tySc = polyType (toQualType m tvs (ArrowType NoSpanInfo ty0 lty))
 
 constrType' :: ModuleIdent -> QualIdent -> [Ident] -> [Ident] -> Context
             -> [TypeExpr] -> ExistTypeScheme
@@ -314,7 +315,8 @@
         pty  = qualifyPredType m $ toConstrType tc tvs' cx tys
 
 constrType :: QualIdent -> [Ident] -> TypeExpr
-constrType tc tvs = foldl ApplyType (ConstructorType tc) $ map VariableType tvs
+constrType tc tvs = foldl (ApplyType NoSpanInfo) (ConstructorType NoSpanInfo tc)
+                      $ map (VariableType NoSpanInfo) tvs
 
 -- We always enter class methods with an arity of 0 into the value environment
 -- because there may be different implementations with different arities.
diff --git a/src/Interfaces.hs b/src/Interfaces.hs
--- a/src/Interfaces.hs
+++ b/src/Interfaces.hs
@@ -22,8 +22,13 @@
     Interface files are updated by the Curry builder when necessary,
     see module "CurryBuilder".
 -}
+{-# LANGUAGE CPP #-}
 module Interfaces (loadInterfaces) where
 
+#if __GLASGOW_HASKELL__ >= 804
+import Prelude hiding ((<>))
+#endif
+
 import           Control.Monad               (unless)
 import qualified Control.Monad.State    as S (StateT, execStateT, gets, modify)
 import qualified Data.Map               as M (insert, member)
@@ -31,6 +36,7 @@
 import           Curry.Base.Ident
 import           Curry.Base.Monad
 import           Curry.Base.Position
+import           Curry.Base.SpanInfo ()
 import           Curry.Base.Pretty
 import           Curry.Files.PathUtils
 import           Curry.Syntax
@@ -71,7 +77,7 @@
 loadInterfaces :: [FilePath] -- ^ 'FilePath's to search in for interfaces
                -> Module a   -- ^ 'Module' header with import declarations
                -> CYIO InterfaceEnv
-loadInterfaces paths (Module _ m _ is _) = do
+loadInterfaces paths (Module _ _ m _ is _) = do
   res <- liftIO $ S.execStateT load (LoaderState initInterfaceEnv paths [])
   if null (errs res) then ok (iEnv res) else failMessages (reverse $ errs res)
   where load = mapM_ (loadInterface [m]) [(p, m') | ImportDecl p m' _ _ _ <- is]
@@ -85,8 +91,9 @@
 -- Otherwise, the compiler checks whether the module has already been imported.
 -- If so, nothing needs to be done, otherwise the interface will be searched
 -- for in the import paths and compiled.
-loadInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> IntfLoader ()
-loadInterface ctxt imp@(p, m)
+loadInterface :: HasPosition a => [ModuleIdent] -> (a, ModuleIdent)
+              -> IntfLoader ()
+loadInterface ctxt imp@(pp, m)
   | m `elem` ctxt = report [errCyclicImport p (m : takeWhile (/= m) ctxt)]
   | otherwise     = do
     isLoaded <- loaded m
@@ -96,12 +103,13 @@
       case mbIntf of
         Nothing -> report [errInterfaceNotFound p m]
         Just fn -> compileInterface ctxt imp fn
+  where p = getPosition pp
 
 -- |Compile an interface by recursively loading its dependencies.
 --
 -- After reading an interface, all imported interfaces are recursively
 -- loaded and inserted into the interface's environment.
-compileInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> FilePath
+compileInterface :: HasPosition p => [ModuleIdent] -> (p, ModuleIdent) -> FilePath
                  -> IntfLoader ()
 compileInterface ctxt (p, m) fn = do
   mbSrc <- liftIO $ readModule fn
@@ -119,18 +127,18 @@
             addInterface m intf'
 
 -- Error message for required interface that could not be found.
-errInterfaceNotFound :: Position -> ModuleIdent -> Message
+errInterfaceNotFound :: HasPosition p => p -> ModuleIdent -> Message
 errInterfaceNotFound p m = posMessage p $
   text "Interface for module" <+> text (moduleName m) <+> text "not found"
 
 -- Error message for an unexpected interface.
-errWrongInterface :: Position -> ModuleIdent -> ModuleIdent -> Message
+errWrongInterface :: HasPosition p => p -> ModuleIdent -> ModuleIdent -> Message
 errWrongInterface p m n = posMessage p $
   text "Expected interface for" <+> text (moduleName m)
   <> comma <+> text "but found" <+> text (moduleName n)
 
 -- Error message for a cyclic import.
-errCyclicImport :: Position -> [ModuleIdent] -> Message
+errCyclicImport :: HasPosition p => p -> [ModuleIdent] -> Message
 errCyclicImport _ []  = internalError "Interfaces.errCyclicImport: empty list"
 errCyclicImport p [m] = posMessage p $
   text "Recursive import for module" <+> text (moduleName m)
diff --git a/src/Modules.hs b/src/Modules.hs
--- a/src/Modules.hs
+++ b/src/Modules.hs
@@ -7,9 +7,10 @@
                        2011 - 2015 Björn Peemöller
                        2016        Jan Tikovsky
                        2016 - 2017 Finn Teegen
+                       2018        Kai-Oliver Prott
     License     :  BSD-3-clause
 
-    Maintainer  :  bjp@informatik.uni-kiel.de
+    Maintainer  :  fte@informatik.uni-kiel.de
     Stability   :  experimental
     Portability :  portable
 
@@ -36,13 +37,15 @@
 
 import Curry.Base.Ident
 import Curry.Base.Monad
-import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Base.Pretty
 import Curry.Base.Span
 import Curry.FlatCurry.InterfaceEquivalence (eqInterface)
 import Curry.Files.Filenames
 import Curry.Files.PathUtils
 import Curry.Syntax.InterfaceEquivalence
+import Curry.Syntax.Utils (shortenModuleAST)
+import Curry.Syntax.Lexer (Token(..), Category(..))
 
 import Base.Messages
 import Base.Types
@@ -64,7 +67,7 @@
 import Html.CurryHtml (source2html)
 import Imports
 import Interfaces (loadInterfaces)
-import TokenStream (showTokenStream)
+import TokenStream (showTokenStream, showCommentTokenStream)
 import Transformations
 
 -- The function 'compileModule' is the main entry-point of this
@@ -86,17 +89,22 @@
 compileModule :: Options -> ModuleIdent -> FilePath -> CYIO ()
 compileModule opts m fn = do
   mdl <- loadAndCheckModule opts m fn
-  writeTokens opts (fst mdl)
-  writeParsed opts mdl
-  writeHtml   opts (qual mdl)
+  writeTokens   opts (fst mdl)
+  writeComments opts (fst mdl)
+  writeParsed   opts mdl
+  let qmdl = qual mdl
+  writeHtml     opts qmdl
+  let umdl = (fst qmdl, fmap (const ()) (snd qmdl))
+  writeAST      opts umdl
+  writeShortAST opts umdl
   mdl' <- expandExports opts mdl
-  qmdl <- dumpWith opts CS.showModule CS.ppModule DumpQualified $ qual mdl'
-  writeAbstractCurry opts qmdl
+  qmdl' <- dumpWith opts CS.showModule CS.ppModule DumpQualified $ qual mdl'
+  writeAbstractCurry opts qmdl'
   -- generate interface file
-  let intf = uncurry exportInterface qmdl
+  let intf = uncurry exportInterface qmdl'
   writeInterface opts (fst mdl') intf
   when withFlat $ do
-    ((env, il), mdl'') <- transModule opts qmdl
+    ((env, il), mdl'') <- transModule opts qmdl'
     writeFlat opts env (snd mdl'') il
   where
   withFlat = any (`elem` optTargetTypes opts) [TypedFlatCurry, FlatCurry]
@@ -180,7 +188,7 @@
 
 -- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
 checkModuleId :: Monad m => ModuleIdent -> CS.Module () -> CYT m (CS.Module ())
-checkModuleId mid m@(CS.Module _ mid' _ _ _)
+checkModuleId mid m@(CS.Module _ _ mid' _ _ _)
   | mid == mid' = ok m
   | otherwise   = failMessages [errModuleFileMismatch mid']
 
@@ -190,7 +198,7 @@
 -- the prelude is imported unqualified, otherwise a qualified import is added.
 
 importPrelude :: Options -> CS.Module () -> CS.Module ()
-importPrelude opts m@(CS.Module ps mid es is ds)
+importPrelude opts m@(CS.Module spi ps mid es is ds)
     -- the Prelude itself
   | mid == preludeMIdent          = m
     -- disabled by compiler option
@@ -198,11 +206,11 @@
     -- already imported
   | preludeMIdent `elem` imported = m
     -- let's add it!
-  | otherwise                     = CS.Module ps mid es (preludeImp : is) ds
+  | otherwise                     = CS.Module spi ps mid es (preludeImp : is) ds
   where
   noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
                  || m `CS.hasLanguageExtension` NoImplicitPrelude
-  preludeImp   = CS.ImportDecl NoPos preludeMIdent
+  preludeImp   = CS.ImportDecl NoSpanInfo preludeMIdent
                   False   -- qualified?
                   Nothing -- no alias
                   Nothing -- no selection of types, functions, etc.
@@ -216,7 +224,7 @@
     interfaceCheck opts (env, intf)
 
 importSyntaxCheck :: Monad m => InterfaceEnv -> CS.Module a -> CYT m [CS.ImportDecl]
-importSyntaxCheck iEnv (CS.Module _ _ _ imps _) = mapM checkImportDecl imps
+importSyntaxCheck iEnv (CS.Module _ _ _ _ imps _) = mapM checkImportDecl imps
   where
   checkImportDecl (CS.ImportDecl p m q asM is) = case Map.lookup m iEnv of
     Just intf -> CS.ImportDecl p m q asM `liftM` importCheck intf is
@@ -288,6 +296,14 @@
   tokTarget  = Tokens `elem` optTargetTypes opts
   useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
 
+writeComments :: Options -> CompilerEnv -> CYIO ()
+writeComments opts env = when tokTarget $ liftIO $
+  writeModule (useSubDir $ commentsName (filePath env))
+              (showCommentTokenStream $ tokens env)
+  where
+  tokTarget  = Comments `elem` optTargetTypes opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
 -- |Output the parsed 'Module' on request
 writeParsed :: Show a => Options -> CompEnv (CS.Module a) -> CYIO ()
 writeParsed opts (env, mdl) = when srcTarget $ liftIO $
@@ -328,19 +344,23 @@
 writeFlat :: Options -> CompilerEnv -> CS.Module Type -> IL.Module -> CYIO ()
 writeFlat opts env mdl il = do
   (_, tfc) <- dumpWith opts show (FC.ppProg . genFlatCurry) DumpTypedFlatCurry (env, tfcyProg)
-  when tfcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tfcyName) tfc
+  when tfcyTarget  $ liftIO $ FC.writeFlatCurry (useSubDir tfcyName) tafcyProg
+  when tafcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tafcyName) tfc
   when fcyTarget $ do
     (_, fc) <- dumpWith opts show FC.ppProg DumpFlatCurry (env, fcyProg)
     liftIO $ FC.writeFlatCurry (useSubDir fcyName) fc
   writeFlatIntf opts env fcyProg
   where
-  tfcyName   = typedFlatName (filePath env)
-  tfcyProg   = genTypedFlatCurry env mdl il
-  tfcyTarget = TypedFlatCurry `elem` optTargetTypes opts
-  fcyName    = flatName (filePath env)
-  fcyProg    = genFlatCurry tfcyProg
-  fcyTarget  = FlatCurry `elem` optTargetTypes opts
-  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+  tfcyName    = typedFlatName (filePath env)
+  tfcyProg    = genTypedFlatCurry env mdl il
+  tfcyTarget  = TypedFlatCurry `elem` optTargetTypes opts
+  tafcyName   = typeAnnFlatName (filePath env)
+  tafcyProg   = genTypeAnnotatedFlatCurry env mdl il
+  tafcyTarget = TypeAnnotatedFlatCurry `elem` optTargetTypes opts
+  fcyName     = flatName (filePath env)
+  fcyProg     = genFlatCurry tfcyProg
+  fcyTarget   = FlatCurry `elem` optTargetTypes opts
+  useSubDir   = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
 
 writeFlatIntf :: Options -> CompilerEnv -> FC.Prog -> CYIO ()
 writeFlatIntf opts env prog
@@ -370,6 +390,24 @@
   acyTarget  = AbstractCurry        `elem` optTargetTypes opts
   uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
   useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
+
+writeAST :: Options -> CompEnv (CS.Module ()) -> CYIO ()
+writeAST opts (env, mdl) = when astTarget $ liftIO $
+  writeModule (useSubDir $ astName (filePath env)) (CS.showModule mdl)
+  where
+  astTarget  = AST `elem` optTargetTypes opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
+
+writeShortAST :: Options -> CompEnv (CS.Module ()) -> CYIO ()
+writeShortAST opts (env, mdl) = when astTarget $ liftIO $
+  writeModule (useSubDir $ shortASTName (filePath env))
+              (CS.showModule $ shortenModuleAST mdl)
+  where
+  astTarget  = ShortAST `elem` optTargetTypes opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
 
 type Dump = (DumpLevel, CompilerEnv, String)
 
diff --git a/src/TokenStream.hs b/src/TokenStream.hs
--- a/src/TokenStream.hs
+++ b/src/TokenStream.hs
@@ -9,7 +9,7 @@
     and spans of a Curry source module into a separate file.
 -}
 
-module TokenStream (showTokenStream) where
+module TokenStream (showTokenStream, showCommentTokenStream) where
 
 import Data.List             (intercalate)
 
@@ -21,20 +21,46 @@
 -- The list is split into one tuple on each line to increase readability.
 showTokenStream :: [(Span, Token)] -> String
 showTokenStream [] = "[]\n"
-showTokenStream ts = "[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
+showTokenStream ts =
+  "[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
   where filteredTs     = filter (not . isVirtual) ts
+        showST (sp, t) = "(" ++ showSpanAsPair sp ++ ", " ++ showToken t ++ ")"
+
+-- |Show a list of 'Span' and 'Token' tuples filtered by CommentTokens.
+-- The list is split into one tuple on each line to increase readability.
+showCommentTokenStream :: [(Span, Token)] -> String
+showCommentTokenStream [] = "[]\n"
+showCommentTokenStream ts =
+  "[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
+  where filteredTs     = filter isComment ts
         showST (sp, t) = "(" ++ showSpan sp ++ ", " ++ showToken t ++ ")"
 
 isVirtual :: (Span, Token) -> Bool
 isVirtual (_, Token cat _) = cat `elem` [EOF, VRightBrace, VSemicolon]
 
+isComment :: (Span, Token) -> Bool
+isComment (_, Token cat _) = cat `elem` [LineComment, NestedComment]
+
 -- show 'span' as "((startLine, startColumn), (endLine, endColumn))"
+showSpanAsPair :: Span -> String
+showSpanAsPair sp =
+  "(" ++ showPosAsPair (start sp) ++ ", " ++ showPos (end sp) ++ ")"
+
+-- show 'span' as "(Span startPos endPos)"
 showSpan :: Span -> String
-showSpan sp = "(" ++ showPos (start sp) ++ ", " ++ showPos (end sp) ++ ")"
+showSpan NoSpan = "NoSpan"
+showSpan Span { start = s, end = e } =
+   "(Span " ++ showPos s ++ " " ++ showPos e ++ ")"
 
--- show 'Position' as "(line, column)"
+-- show 'position' as "(Position line column)"
 showPos :: Position -> String
-showPos p = "(" ++ show (line p) ++ ", " ++ show (column p) ++ ")"
+showPos NoPos = "NoPos"
+showPos Position { line = l, column = c } =
+  "(Position " ++ show l++ " " ++ show c ++ ")"
+
+-- show 'Position' as "(line, column)"
+showPosAsPair :: Position -> String
+showPosAsPair p = "(" ++ show (line p) ++ ", " ++ show (column p) ++ ")"
 
 -- |Show tokens and their value if needed
 showToken :: Token -> String
diff --git a/src/Transformations/CaseCompletion.hs b/src/Transformations/CaseCompletion.hs
--- a/src/Transformations/CaseCompletion.hs
+++ b/src/Transformations/CaseCompletion.hs
@@ -109,7 +109,7 @@
   bs' <- mapM ccAlt bs
   ccCase ea e' bs'
 ccExpr (Or            e1 e2) = Or <$> ccExpr e1 <*> ccExpr e2
-ccExpr (Exist           v e) = Exist v <$> ccExpr e
+ccExpr (Exist        v ty e) = Exist v ty <$> ccExpr e
 ccExpr (Let             b e) = Let <$> ccBinding b <*> ccExpr e
 ccExpr (Letrec         bs e) = Letrec <$> mapM ccBinding bs <*> ccExpr e
 ccExpr (Typed          e ty) = flip Typed ty <$> ccExpr e
@@ -278,9 +278,9 @@
   = Case ev (replaceVar v e e') (map (replaceVarInAlt v e) bs)
 replaceVar v e (Or        e1 e2)
   = Or (replaceVar v e e1) (replaceVar v e e2)
-replaceVar v e (Exist      w e')
-   | v == w                     = Exist w e'
-   | otherwise                  = Exist w (replaceVar v e e')
+replaceVar v e (Exist   w ty e')
+   | v == w                     = Exist w ty e'
+   | otherwise                  = Exist w ty (replaceVar v e e')
 replaceVar v e (Let        b e')
    | v `occursInBinding` b      = Let b e'
    | otherwise                  = Let (replaceVarInBinding v e b)
diff --git a/src/Transformations/CurryToIL.hs b/src/Transformations/CurryToIL.hs
--- a/src/Transformations/CurryToIL.hs
+++ b/src/Transformations/CurryToIL.hs
@@ -49,7 +49,7 @@
 import qualified IL as IL
 
 ilTrans :: ValueEnv -> Module Type -> IL.Module
-ilTrans vEnv (Module _ m _ _ ds) = IL.Module m (imports m ds') ds'
+ilTrans vEnv (Module _ _ m _ _ ds) = IL.Module m (imports m ds') ds'
   where ds' = R.runReader (concatMapM trDecl ds) (TransEnv m vEnv)
 
 -- -----------------------------------------------------------------------------
@@ -85,7 +85,7 @@
   mdlsPattern (IL.ConstructorPattern _ c _) = modules c
   mdlsPattern _                             = id
 mdlsExpr (IL.Or          e1 e2) ms = mdlsExpr e1 (mdlsExpr e2 ms)
-mdlsExpr (IL.Exist         _ e) ms = mdlsExpr e ms
+mdlsExpr (IL.Exist       _ _ e) ms = mdlsExpr e ms
 mdlsExpr (IL.Let           b e) ms = mdlsBinding b (mdlsExpr e ms)
 mdlsExpr (IL.Letrec       bs e) ms = foldr mdlsBinding (mdlsExpr e ms) bs
 mdlsExpr _                      ms = ms
@@ -235,7 +235,7 @@
            -> [Ident]       -- infinite list of additional identifiers
            -> Equation Type -- equation to be translated
            -> TransM Match  -- nested constructor terms + translated RHS
-trEquation vs vs' (Equation _ (FunLhs _ ts) rhs) = do
+trEquation vs vs' (Equation _ (FunLhs _ _ ts) rhs) = do
   -- construct renaming of variables inside constructor terms
   let patternRenaming = foldr2 bindRenameEnv Map.empty vs ts
   -- translate right-hand-side
@@ -249,18 +249,18 @@
 
 -- Construct a renaming of all variables inside the pattern to fresh identifiers
 bindRenameEnv :: Ident -> Pattern a -> RenameEnv -> RenameEnv
-bindRenameEnv _ (LiteralPattern        _ _) env = env
-bindRenameEnv v (VariablePattern      _ v') env = Map.insert v' v env
-bindRenameEnv v (ConstructorPattern _ _ ts) env
+bindRenameEnv _ (LiteralPattern        _ _ _) env = env
+bindRenameEnv v (VariablePattern      _ _ v') env = Map.insert v' v env
+bindRenameEnv v (ConstructorPattern _ _ _ ts) env
   = foldr2 bindRenameEnv env (argNames v) ts
-bindRenameEnv v (AsPattern            v' t) env
+bindRenameEnv v (AsPattern            _ v' t) env
   = Map.insert v' v (bindRenameEnv v t env)
 bindRenameEnv _ _                           _
   = internalError "CurryToIL.bindRenameEnv"
 
 trRhs :: [Ident] -> RenameEnv -> Rhs Type -> TransM IL.Expression
 trRhs vs env (SimpleRhs _ e _) = trExpr vs env e
-trRhs _  _   (GuardedRhs _  _) = internalError "CurryToIL.trRhs: GuardedRhs"
+trRhs _  _   (GuardedRhs _ _  _) = internalError "CurryToIL.trRhs: GuardedRhs"
 
 -- Note that the case matching algorithm assumes that the matched
 -- expression is accessible through a variable. The translation of case
@@ -271,32 +271,32 @@
 -- instance, if one of the alternatives contains an as-pattern.
 
 trExpr :: [Ident] -> RenameEnv -> Expression Type -> TransM IL.Expression
-trExpr _  _   (Literal     ty l) = return $ IL.Literal (transType ty) (trLiteral l)
-trExpr _  env (Variable    ty v)
+trExpr _  _   (Literal     _ ty l) = return $ IL.Literal (transType ty) (trLiteral l)
+trExpr _  env (Variable    _ ty v)
   | isQualified v = fun
   | otherwise     = case Map.lookup (unqualify v) env of
       Nothing -> fun
       Just v' -> return $ IL.Variable (transType ty) v' -- apply renaming
   where fun = (IL.Function (transType ty) v . arrowArity) <$> varType v
-trExpr _  _   (Constructor ty c)
+trExpr _  _   (Constructor _ ty c)
   = (IL.Constructor (transType ty) c . arrowArity) <$> constrType c
-trExpr vs env (Apply     e1 e2)
+trExpr vs env (Apply     _ e1 e2)
   = IL.Apply <$> trExpr vs env e1 <*> trExpr vs env e2
-trExpr vs env (Let        ds e) = do
+trExpr vs env (Let        _ ds e) = do
   e' <- trExpr vs env' e
   case ds of
     [FreeDecl _ vs']
-       -> return $ foldr IL.Exist e' $ map varIdent vs'
+       -> return $ foldr (\ (Var ty v) -> IL.Exist v (transType ty)) e' vs'
     [d] | all (`notElem` bv d) (qfv emptyMIdent d)
       -> flip IL.Let    e' <$>      trBinding d
     _ -> flip IL.Letrec e' <$> mapM trBinding ds
   where
   env' = foldr2 Map.insert env bvs bvs
   bvs  = bv ds
-  trBinding (PatternDecl _ (VariablePattern _ v) rhs)
+  trBinding (PatternDecl _ (VariablePattern _ _ v) rhs)
     = IL.Binding v <$> trRhs vs env' rhs
   trBinding p = error $ "unexpected binding: " ++ show p
-trExpr (v:vs) env (Case ct e alts) = do
+trExpr (v:vs) env (Case _ ct e alts) = do
   -- the ident v is used for the case expression subject, as this could
   -- be referenced in the case alternatives by a variable pattern
   e' <- trExpr vs env e
@@ -311,7 +311,7 @@
         -- subject is referenced -> introduce binding for v as subject
       | v `elem` fv expr                -> IL.Let (IL.Binding v e') expr
       | otherwise                       -> expr
-trExpr  vs env (Typed e (QualTypeExpr _ ty)) =
+trExpr  vs env (Typed _ e (QualTypeExpr _ _ ty)) =
   flip IL.Typed ty' <$> trExpr vs env e
   where ty' = transType (toType [] ty)
 trExpr _ _ _ = internalError "CurryToIL.trExpr"
@@ -340,16 +340,16 @@
 arguments (NestedTerm _ ts) = ts
 
 trPattern :: Ident -> Pattern Type -> NestedTerm
-trPattern _ (LiteralPattern        ty l)
+trPattern _ (LiteralPattern        _ ty l)
   = NestedTerm (IL.LiteralPattern (transType ty) $ trLiteral l) []
-trPattern v (VariablePattern       ty _)
+trPattern v (VariablePattern       _ ty _)
   = NestedTerm (IL.VariablePattern (transType ty) v) []
-trPattern v (ConstructorPattern ty c ts)
+trPattern v (ConstructorPattern _ ty c ts)
   = NestedTerm (IL.ConstructorPattern (transType ty) c vs')
                (zipWith trPattern vs ts)
   where vs  = argNames v
         vs' = zip (map (transType . typeOf) ts) vs
-trPattern v (AsPattern              _ t) = trPattern v t
+trPattern v (AsPattern              _ _ t) = trPattern v t
 trPattern _ _                            = internalError "CurryToIL.trPattern"
 
 argNames :: Ident -> [Ident]
diff --git a/src/Transformations/Derive.hs b/src/Transformations/Derive.hs
--- a/src/Transformations/Derive.hs
+++ b/src/Transformations/Derive.hs
@@ -22,7 +22,7 @@
 import qualified Data.Set   as Set (deleteMin, union)
 
 import Curry.Base.Ident
-import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.CurryTypes (fromPredType)
@@ -50,7 +50,7 @@
 
 derive :: TCEnv -> ValueEnv -> InstEnv -> OpPrecEnv -> Module PredType
        -> Module PredType
-derive tcEnv vEnv inEnv pEnv (Module ps m es is ds) = Module ps m es is $
+derive tcEnv vEnv inEnv pEnv (Module spi ps m es is ds) = Module spi ps m es is $
   ds ++ concat (S.evalState (mapM deriveInstances tds) initState)
   where tds = filter isTypeDecl ds
         initState = DVState m tcEnv vEnv inEnv pEnv 1
@@ -101,9 +101,9 @@
   let ps = snd3 $ fromJust $ lookupInstInfo (cls, tc) inEnv
       ty = applyType (TypeConstructor tc) $
              take (length tvs) $ map TypeVariable [0 ..]
-      QualTypeExpr cx inst = fromPredType tvs $ PredType ps ty
+      QualTypeExpr _ cx inst = fromPredType tvs $ PredType ps ty
   ds <- deriveMethods cls ty cis ps
-  return $ InstanceDecl NoPos cx cls inst ds
+  return $ InstanceDecl NoSpanInfo cx cls inst ds
 
 -- Note: The methods and arities of the generated instance declarations have to
 -- correspond to the methods and arities entered previously into the instance
@@ -133,7 +133,7 @@
 deriveBinOp cls op expr ty cis ps = do
   pty <- getInstMethodType ps cls ty op
   eqs <- mapM (deriveBinOpEquation op expr ty) $ sequence [cis, cis]
-  return $ FunctionDecl NoPos pty op eqs
+  return $ FunctionDecl NoSpanInfo pty op eqs
 
 deriveBinOpEquation :: Ident -> BinOpExpr -> Type -> [ConstrInfo]
                     -> DVM (Equation PredType)
@@ -144,7 +144,7 @@
       pat2 = constrPattern pty c2 vs2
       es1 = map (uncurry mkVar) vs1
       es2 = map (uncurry mkVar) vs2
-  return $ mkEquation NoPos op [pat1, pat2] $ expr i1 es1 i2 es2
+  return $ mkEquation NoSpanInfo op [pat1, pat2] $ expr i1 es1 i2 es2
   where pty = predType $ instType ty
 deriveBinOpEquation _ _ _ _ = internalError "Derive.deriveBinOpEquation"
 
@@ -194,7 +194,7 @@
                  -> DVM (Decl PredType)
 deriveSuccOrPred f ty cis1 cis2 ps = do
   pty <- getInstMethodType ps qEnumId ty f
-  FunctionDecl NoPos pty f <$> if null eqs
+  FunctionDecl NoSpanInfo pty f <$> if null eqs
                                  then do
                                         v <- freshArgument $ instType ty
                                         return [failedEquation f ty v]
@@ -204,63 +204,70 @@
 succOrPredEquation :: Ident -> Type -> ConstrInfo -> ConstrInfo
                    -> Equation PredType
 succOrPredEquation f ty (_, c1, _, _) (_, c2, _, _) =
-  mkEquation NoPos f [ConstructorPattern pty c1 []] $ Constructor pty c2
+  mkEquation NoSpanInfo f [ConstructorPattern NoSpanInfo pty c1 []] $
+    Constructor NoSpanInfo pty c2
   where pty = predType $ instType ty
 
 failedEquation :: Ident -> Type -> (PredType, Ident) -> Equation PredType
 failedEquation f ty v =
-  mkEquation NoPos f [uncurry VariablePattern v] $ preludeFailed $ instType ty
+  mkEquation NoSpanInfo f [uncurry (VariablePattern NoSpanInfo) v] $
+    preludeFailed $ instType ty
 
 deriveToEnum :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
 deriveToEnum ty cis ps = do
   pty <- getInstMethodType ps qEnumId ty toEnumId
-  return $ FunctionDecl NoPos pty toEnumId eqs
+  return $ FunctionDecl NoSpanInfo pty toEnumId eqs
   where eqs = zipWith (toEnumEquation ty) [0 ..] cis
 
 toEnumEquation :: Type -> Integer -> ConstrInfo -> Equation PredType
 toEnumEquation ty i (_, c, _, _) =
-  mkEquation NoPos toEnumId [LiteralPattern (predType intType) (Int i)] $
-    Constructor (predType $ instType ty) c
+  mkEquation NoSpanInfo toEnumId
+    [LiteralPattern NoSpanInfo (predType intType) (Int i)] $
+    Constructor NoSpanInfo (predType $ instType ty) c
 
 deriveFromEnum :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
 deriveFromEnum ty cis ps = do
   pty <- getInstMethodType ps qEnumId ty fromEnumId
-  return $ FunctionDecl NoPos pty fromEnumId eqs
+  return $ FunctionDecl NoSpanInfo pty fromEnumId eqs
   where eqs = zipWith (fromEnumEquation ty) cis [0 ..]
 
 fromEnumEquation :: Type -> ConstrInfo -> Integer -> Equation PredType
 fromEnumEquation ty (_, c, _, _) i =
-  mkEquation NoPos fromEnumId [ConstructorPattern pty c []] $
-    Literal (predType intType) $ Int i
+  mkEquation NoSpanInfo fromEnumId [ConstructorPattern NoSpanInfo pty c []] $
+    Literal NoSpanInfo (predType intType) $ Int i
   where pty = predType $ instType ty
 
 deriveEnumFrom :: Type -> ConstrInfo -> PredSet -> DVM (Decl PredType)
 deriveEnumFrom ty (_, c, _, _) ps = do
   pty <- getInstMethodType ps qEnumId ty enumFromId
   v <- freshArgument $ instType ty
-  return $ funDecl NoPos pty enumFromId [uncurry VariablePattern v] $
+  return $ funDecl NoSpanInfo pty enumFromId
+    [uncurry (VariablePattern NoSpanInfo) v] $
     enumFromExpr v c
 
 enumFromExpr :: (PredType, Ident) -> QualIdent -> Expression PredType
-enumFromExpr v c = prelEnumFromTo (uncurry mkVar v) $ Constructor (fst v) c
+enumFromExpr v c = prelEnumFromTo (uncurry mkVar v) $
+  Constructor NoSpanInfo (fst v) c
 
 deriveEnumFromThen :: Type -> ConstrInfo -> ConstrInfo -> PredSet
                    -> DVM (Decl PredType)
 deriveEnumFromThen ty (_, c1, _, _) (_, c2, _, _) ps = do
   pty <- getInstMethodType ps qEnumId ty enumFromId
   vs@[v1, v2] <- mapM (freshArgument . instType) $ replicate 2 ty
-  return $ funDecl NoPos pty enumFromThenId (map (uncurry VariablePattern) vs) $
+  return $ funDecl NoSpanInfo pty enumFromThenId
+    (map (uncurry (VariablePattern NoSpanInfo)) vs) $
     enumFromThenExpr v1 v2 c1 c2
 
 enumFromThenExpr :: (PredType, Ident) -> (PredType, Ident) -> QualIdent
                  -> QualIdent -> Expression PredType
 enumFromThenExpr v1 v2 c1 c2 =
   prelEnumFromThenTo (uncurry mkVar v1) (uncurry mkVar v2) $ boundedExpr
-  where boundedExpr = IfThenElse (prelLeq
+  where boundedExpr = IfThenElse NoSpanInfo
+                                 (prelLeq
                                    (prelFromEnum $ uncurry mkVar v1)
                                    (prelFromEnum $ uncurry mkVar v2))
-                                 (Constructor (fst v1) c2)
-                                 (Constructor (fst v1) c1)
+                                 (Constructor NoSpanInfo (fst v1) c2)
+                                 (Constructor NoSpanInfo (fst v1) c1)
 
 -- Upper and Lower Bounds:
 
@@ -274,12 +281,13 @@
                     -> DVM (Decl PredType)
 deriveMaxOrMinBound f ty (_, c, _, tys) ps = do
   pty <- getInstMethodType ps qBoundedId ty $ unqualify f
-  return $ funDecl NoPos pty (unqualify f) [] $ maxOrMinBoundExpr f c ty tys
+  return $ funDecl NoSpanInfo pty (unqualify f) [] $ maxOrMinBoundExpr f c ty tys
 
 maxOrMinBoundExpr :: QualIdent -> QualIdent -> Type -> [Type]
                   -> Expression PredType
 maxOrMinBoundExpr f c ty tys =
-  apply (Constructor pty c) $ map (flip Variable f . predType) instTys
+  apply (Constructor NoSpanInfo pty c) $
+  map (flip (Variable NoSpanInfo) f . predType) instTys
   where instTy:instTys = map instType $ ty : tys
         pty = predType $ foldr TypeArrow instTy instTys
 
@@ -293,15 +301,15 @@
   pty <- getInstMethodType ps qReadId ty $ readsPrecId
   d <- freshArgument intType
   r <- freshArgument stringType
-  let pats = map (uncurry VariablePattern) [d, r]
-  funDecl NoPos pty readsPrecId pats <$>
+  let pats = map (uncurry (VariablePattern NoSpanInfo)) [d, r]
+  funDecl NoSpanInfo pty readsPrecId pats <$>
     deriveReadsPrecExpr ty cis (uncurry mkVar d) (uncurry mkVar r)
 
 deriveReadsPrecExpr :: Type -> [ConstrInfo] -> Expression PredType
                     -> Expression PredType -> DVM (Expression PredType)
 deriveReadsPrecExpr ty cis d r = do
   es <- mapM (deriveReadsPrecReadParenExpr ty d) cis
-  return $ foldr1 prelAppend $ map (flip Apply r) $ es
+  return $ foldr1 prelAppend $ map (flip (Apply NoSpanInfo) r) $ es
 
 deriveReadsPrecReadParenExpr :: Type -> Expression PredType -> ConstrInfo
                              -> DVM (Expression PredType)
@@ -316,9 +324,9 @@
 readsPrecReadParenCondExpr (_, c, _, tys) d p
   | null tys                        = prelFalse
   | isQInfixOp c && length tys == 2 =
-    prelLt (Literal predIntType $ Int p) d
+    prelLt (Literal NoSpanInfo predIntType $ Int p) d
   | otherwise                       =
-    prelLt (Literal predIntType $ Int 10) d
+    prelLt (Literal NoSpanInfo predIntType $ Int 10) d
 
 deriveReadsPrecLambdaExpr :: Type -> ConstrInfo -> Precedence
                       -> DVM (Expression PredType)
@@ -326,10 +334,12 @@
   r <- freshArgument stringType
   (stmts, vs, s) <- deriveReadsPrecStmts (unqualify c) (p + 1) r ls tys
   let pty = predType $ foldr TypeArrow (instType ty) $ map instType tys
-      e = Tuple [ apply (Constructor pty c) $ map (uncurry mkVar) vs
+      e = Tuple NoSpanInfo
+                [ apply (Constructor NoSpanInfo pty c) $ map (uncurry mkVar) vs
                 , uncurry mkVar s
                 ]
-  return $ Lambda [uncurry VariablePattern r] $ ListCompr e stmts
+  return $ Lambda NoSpanInfo [uncurry (VariablePattern NoSpanInfo) r]
+         $ ListCompr NoSpanInfo e stmts
 
 deriveReadsPrecStmts
   :: Ident -> Precedence -> (PredType, Ident) -> Maybe [Ident] -> [Type]
@@ -391,11 +401,11 @@
                       -> DVM ((PredType, Ident), Statement PredType)
 deriveReadsPrecLexStmt str r = do
   s <- freshArgument $ stringType
-  let pat  = TuplePattern
-               [ LiteralPattern predStringType $ String str
-               , uncurry VariablePattern s
+  let pat  = TuplePattern NoSpanInfo
+               [ LiteralPattern NoSpanInfo predStringType $ String str
+               , uncurry (VariablePattern NoSpanInfo) s
                ]
-      stmt = StmtBind pat $ preludeLex $ uncurry mkVar r
+      stmt = StmtBind NoSpanInfo pat $ preludeLex $ uncurry mkVar r
   return (s, stmt)
 
 deriveReadsPrecReadsPrecStmt  :: Precedence -> (PredType, Ident) -> Type
@@ -403,8 +413,9 @@
 deriveReadsPrecReadsPrecStmt p r ty = do
   v <- freshArgument $ instType ty
   s <- freshArgument $ stringType
-  let pat  = TuplePattern $ map (uncurry VariablePattern) [v, s]
-      stmt = StmtBind pat $ preludeReadsPrec (instType ty) p $
+  let pat  = TuplePattern NoSpanInfo $
+               map (uncurry (VariablePattern NoSpanInfo)) [v, s]
+      stmt = StmtBind NoSpanInfo pat $ preludeReadsPrec (instType ty) p $
                uncurry mkVar r
   return (s, (stmt, v))
 
@@ -417,15 +428,15 @@
 deriveShowsPrec ty cis ps = do
   pty <- getInstMethodType ps qShowId ty $ showsPrecId
   eqs <- mapM (deriveShowsPrecEquation ty) cis
-  return $ FunctionDecl NoPos pty showsPrecId eqs
+  return $ FunctionDecl NoSpanInfo pty showsPrecId eqs
 
 deriveShowsPrecEquation :: Type -> ConstrInfo -> DVM (Equation PredType)
 deriveShowsPrecEquation ty (_, c, ls, tys) = do
   d <- freshArgument intType
   vs <- mapM (freshArgument . instType) tys
-  let pats = [uncurry VariablePattern d, constrPattern pty c vs]
+  let pats = [uncurry (VariablePattern NoSpanInfo) d, constrPattern pty c vs]
   pEnv <- getPrecEnv
-  return $ mkEquation NoPos showsPrecId pats $ showsPrecExpr (unqualify c)
+  return $ mkEquation NoSpanInfo showsPrecId pats $ showsPrecExpr (unqualify c)
     (precedence c pEnv) ls (uncurry mkVar d) $ map (uncurry mkVar) vs
   where pty = predType $ instType ty
 
@@ -446,7 +457,7 @@
 showsPrecShowParenExpr :: Expression PredType -> Precedence
                        -> Expression PredType -> Expression PredType
 showsPrecShowParenExpr d p =
-  prelShowParen $ prelLt (Literal predIntType $ Int p) d
+  prelShowParen $ prelLt (Literal NoSpanInfo predIntType $ Int p) d
 
 showsPrecRecordConstrExpr :: Ident -> [Ident] -> [Expression PredType]
                           -> Expression PredType
@@ -537,84 +548,92 @@
 -- -----------------------------------------------------------------------------
 
 prelTrue :: Expression PredType
-prelTrue = Constructor predBoolType qTrueId
+prelTrue = Constructor NoSpanInfo predBoolType qTrueId
 
 prelFalse :: Expression PredType
-prelFalse = Constructor predBoolType qFalseId
+prelFalse = Constructor NoSpanInfo predBoolType qFalseId
 
 prelAppend :: Expression PredType -> Expression PredType -> Expression PredType
-prelAppend e1 e2 = foldl1 Apply [Variable pty qAppendOpId, e1, e2]
+prelAppend e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qAppendOpId, e1, e2]
   where pty = predType $ foldr1 TypeArrow $ replicate 3 $ typeOf e1
 
 prelDot :: Expression PredType -> Expression PredType -> Expression PredType
-prelDot e1 e2 = foldl1 Apply [Variable pty qDotOpId, e1, e2]
+prelDot e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qDotOpId, e1, e2]
   where ty1@(TypeArrow _    ty12) = typeOf e1
         ty2@(TypeArrow ty21 _   ) = typeOf e2
         pty = predType $ foldr1 TypeArrow [ty1, ty2, ty21, ty12]
 
 prelAnd :: Expression PredType -> Expression PredType -> Expression PredType
-prelAnd e1 e2 = foldl1 Apply [Variable pty qAndOpId, e1, e2]
+prelAnd e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qAndOpId, e1, e2]
   where pty = predType $ foldr1 TypeArrow $ replicate 3 boolType
 
 prelEq :: Expression PredType -> Expression PredType -> Expression PredType
-prelEq e1 e2 = foldl1 Apply [Variable pty qEqOpId, e1, e2]
+prelEq e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qEqOpId, e1, e2]
   where ty = typeOf e1
         pty = predType $ foldr1 TypeArrow [ty, ty, boolType]
 
 prelLeq :: Expression PredType -> Expression PredType -> Expression PredType
-prelLeq e1 e2 = foldl1 Apply [Variable pty qLeqOpId, e1, e2]
+prelLeq e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qLeqOpId, e1, e2]
   where ty = typeOf e1
         pty = predType $ foldr1 TypeArrow [ty, ty, boolType]
 
 prelLt :: Expression PredType -> Expression PredType -> Expression PredType
-prelLt e1 e2 = foldl1 Apply [Variable pty qLtOpId, e1, e2]
+prelLt e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qLtOpId, e1, e2]
   where ty = typeOf e1
         pty = predType $ foldr1 TypeArrow [ty, ty, boolType]
 
 prelOr :: Expression PredType -> Expression PredType -> Expression PredType
-prelOr e1 e2 = foldl1 Apply [Variable pty qOrOpId, e1, e2]
+prelOr e1 e2 = foldl1 (Apply NoSpanInfo)
+  [Variable NoSpanInfo pty qOrOpId, e1, e2]
   where pty = predType $ foldr1 TypeArrow $ replicate 3 boolType
 
 prelFromEnum :: Expression PredType -> Expression PredType
-prelFromEnum e = Apply (Variable pty qFromEnumId) e
+prelFromEnum e = Apply NoSpanInfo (Variable NoSpanInfo pty qFromEnumId) e
   where pty = predType $ TypeArrow (typeOf e) intType
 
 prelEnumFromTo :: Expression PredType -> Expression PredType
                -> Expression PredType
-prelEnumFromTo e1 e2 = apply (Variable pty qEnumFromToId) [e1, e2]
+prelEnumFromTo e1 e2 = apply (Variable NoSpanInfo pty qEnumFromToId) [e1, e2]
   where ty = typeOf e1
         pty = predType $ foldr1 TypeArrow [ty, ty, listType ty]
 
 prelEnumFromThenTo :: Expression PredType -> Expression PredType
                    -> Expression PredType -> Expression PredType
 prelEnumFromThenTo e1 e2 e3 =
-  apply (Variable pty qEnumFromThenToId) [e1, e2, e3]
+  apply (Variable NoSpanInfo pty qEnumFromThenToId) [e1, e2, e3]
   where ty = typeOf e1
         pty = predType $ foldr1 TypeArrow [ty, ty, ty, listType ty]
 
 prelReadParen :: Expression PredType -> Expression PredType
               -> Expression PredType
-prelReadParen e1 e2 = apply (Variable pty qReadParenId) [e1, e2]
+prelReadParen e1 e2 = apply (Variable NoSpanInfo pty qReadParenId) [e1, e2]
   where ty = typeOf e2
         pty = predType $ foldr1 TypeArrow [boolType, ty, ty]
 
 prelShowParen :: Expression PredType -> Expression PredType
               -> Expression PredType
-prelShowParen e1 e2 = apply (Variable pty qShowParenId) [e1, e2]
+prelShowParen e1 e2 = apply (Variable NoSpanInfo pty qShowParenId) [e1, e2]
   where pty = predType $ foldr1 TypeArrow [ boolType
                                           , TypeArrow stringType stringType
                                           , stringType, stringType
                                           ]
 
 preludeLex :: Expression PredType -> Expression PredType
-preludeLex e = Apply (Variable pty qLexId) e
+preludeLex e = Apply NoSpanInfo (Variable NoSpanInfo pty qLexId) e
   where pty = predType $ TypeArrow stringType $
                 listType $ tupleType [stringType, stringType]
 
 preludeReadsPrec :: Type -> Integer -> Expression PredType
                  -> Expression PredType
-preludeReadsPrec ty p e = flip Apply e $
-  Apply (Variable pty qReadsPrecId) $ Literal predIntType $ Int p
+preludeReadsPrec ty p e = flip (Apply NoSpanInfo) e $
+  Apply NoSpanInfo (Variable NoSpanInfo pty qReadsPrecId) $
+  Literal NoSpanInfo predIntType $ Int p
   where pty = predType $ foldr1 TypeArrow [ intType, stringType
                                           , listType $ tupleType [ ty
                                                                  , stringType
@@ -622,16 +641,17 @@
                                           ]
 
 preludeShowsPrec :: Integer -> Expression PredType -> Expression PredType
-preludeShowsPrec p e = flip Apply e $
-  Apply (Variable pty qShowsPrecId) $ Literal predIntType $ Int p
+preludeShowsPrec p e = flip (Apply NoSpanInfo) e $
+  Apply NoSpanInfo (Variable NoSpanInfo pty qShowsPrecId) $
+  Literal NoSpanInfo predIntType $ Int p
   where pty = predType $ foldr1 TypeArrow [ intType, typeOf e
                                           , stringType, stringType
                                           ]
 
 preludeShowString :: String -> Expression PredType
-preludeShowString s = Apply (Variable pty qShowStringId) $
-  Literal predStringType $ String s
+preludeShowString s = Apply NoSpanInfo (Variable NoSpanInfo pty qShowStringId) $
+  Literal NoSpanInfo predStringType $ String s
   where pty = predType $ foldr1 TypeArrow $ replicate 3 stringType
 
 preludeFailed :: Type -> Expression PredType
-preludeFailed ty = Variable (predType ty) qFailedId
+preludeFailed ty = Variable NoSpanInfo (predType ty) qFailedId
diff --git a/src/Transformations/Desugar.hs b/src/Transformations/Desugar.hs
--- a/src/Transformations/Desugar.hs
+++ b/src/Transformations/Desugar.hs
@@ -69,7 +69,7 @@
 import qualified Data.Set            as Set (Set, empty, member, insert)
 
 import Curry.Base.Ident
-import Curry.Base.Position hiding (first)
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.Expr
@@ -84,6 +84,8 @@
 import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTypeInfo)
 import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
 
+-- TODO: some types keep their spanInfo, some don't. Probably none of them are needed
+
 -- The desugaring phase keeps only the type, function, and value
 -- declarations of the module, i.e., type signatures are discarded.
 -- While record declarations are transformed into ordinary data/newtype
@@ -94,8 +96,8 @@
 
 desugar :: [KnownExtension] -> ValueEnv -> TCEnv -> Module PredType
         -> (Module PredType, ValueEnv)
-desugar xs vEnv tcEnv (Module ps m es is ds)
-  = (Module ps m es is ds', valueEnv s')
+desugar xs vEnv tcEnv (Module spi ps m es is ds)
+  = (Module spi ps m es is ds', valueEnv s')
   where (ds', s') = S.runState (desugarModuleDecls ds)
                                (DesugarState m xs tcEnv vEnv 1)
 
@@ -197,7 +199,7 @@
 dsRecordDecl d = return [d]
 
 -- Generate a selector function for a single record label
-genSelFun :: Position -> [QualIdent] -> Ident -> DsM (Decl PredType)
+genSelFun :: SpanInfo -> [QualIdent] -> Ident -> DsM (Decl PredType)
 genSelFun p qcs l = do
   m <- getModuleIdent
   vEnv <- getValueEnv
@@ -206,7 +208,7 @@
 
 -- Generate a selector equation for a label and a constructor if the label
 -- is applicable, otherwise the empty list is returned.
-genSelEqn :: Position -> Ident -> QualIdent -> DsM [Equation PredType]
+genSelEqn :: SpanInfo -> Ident -> QualIdent -> DsM [Equation PredType]
 genSelEqn p l qc = do
   vEnv <- getValueEnv
   let (ls, ty) = conType qc vEnv
@@ -261,7 +263,7 @@
 dsDeclRhs :: Decl PredType -> DsM (Decl PredType)
 dsDeclRhs (FunctionDecl p pty f eqs) =
   FunctionDecl p pty f <$> mapM dsEquation eqs
-dsDeclRhs (PatternDecl      p t rhs) = PatternDecl p t <$> dsRhs p id rhs
+dsDeclRhs (PatternDecl      p t rhs) = PatternDecl p t <$> dsRhs id rhs
 dsDeclRhs d@(FreeDecl           _ _) = return d
 dsDeclRhs d@(ExternalDecl       _ _) = return d
 dsDeclRhs _                          =
@@ -273,9 +275,9 @@
   (     cs1, ts1) <- dsNonLinearity         ts
   (ds1, cs2, ts2) <- dsFunctionalPatterns p ts1
   (ds2,      ts3) <- mapAccumM (dsPat p) [] ts2
-  rhs'            <- dsRhs p (constrain cs2 . constrain cs1)
-                             (addDecls (ds1 ++ ds2) rhs)
-  return $ Equation p (FunLhs f ts3) rhs'
+  rhs'            <- dsRhs (constrain cs2 . constrain cs1)
+                           (addDecls (ds1 ++ ds2) rhs)
+  return $ Equation p (FunLhs NoSpanInfo f ts3) rhs'
   where (f, ts) = flatLhs lhs
 
 -- Constrain an expression by a list of constraints.
@@ -296,25 +298,24 @@
 -- type 'Bool' of the guard because the guard's type defaults to
 -- 'Success' if it is not restricted by the guard expression.
 
-dsRhs :: Position -> (Expression PredType -> Expression PredType)
+dsRhs :: (Expression PredType -> Expression PredType)
       -> Rhs PredType -> DsM (Rhs PredType)
-dsRhs p f rhs =     expandRhs (prelFailed (typeOf rhs)) f rhs
-                >>= dsExpr pRhs
-                >>= return . simpleRhs pRhs
-  where
-  pRhs = fromMaybe p (getRhsPosition rhs)
+dsRhs f rhs =   expandRhs (prelFailed (typeOf rhs)) f rhs
+            >>= dsExpr (getSpanInfo rhs)
+            >>= return . simpleRhs (getSpanInfo rhs)
 
 expandRhs :: Expression PredType -> (Expression PredType -> Expression PredType)
           -> Rhs PredType -> DsM (Expression PredType)
-expandRhs _  f (SimpleRhs _ e ds) = return $ Let ds (f e)
-expandRhs e0 f (GuardedRhs es ds) = (Let ds . f) <$> expandGuards e0 es
+expandRhs _  f (SimpleRhs _ e ds) = return $ Let NoSpanInfo ds (f e)
+expandRhs e0 f (GuardedRhs _ es ds) = (Let NoSpanInfo ds . f)
+                                   <$> expandGuards e0 es
 
 expandGuards :: Expression PredType -> [CondExpr PredType]
              -> DsM (Expression PredType)
 expandGuards e0 es =
   return $ if boolGuards es then foldr mkIfThenElse e0 es else mkCond es
   where
-  mkIfThenElse (CondExpr _ g e) = IfThenElse g e
+  mkIfThenElse (CondExpr _ g e) = IfThenElse NoSpanInfo g e
   mkCond [CondExpr _ g e] = g &> e
   mkCond _                = error "Desugar.expandGuards.mkCond: non-unary list"
 
@@ -325,11 +326,7 @@
 -- Add additional declarations to a right-hand side
 addDecls :: [Decl PredType] -> Rhs PredType -> Rhs PredType
 addDecls ds (SimpleRhs p e ds') = SimpleRhs p e (ds ++ ds')
-addDecls ds (GuardedRhs es ds') = GuardedRhs es (ds ++ ds')
-
-getRhsPosition :: Rhs a -> Maybe Position
-getRhsPosition (SimpleRhs p _ _) = Just p
-getRhsPosition (GuardedRhs  _ _) = Nothing
+addDecls ds (GuardedRhs spi es ds') = GuardedRhs spi es (ds ++ ds')
 
 -- -----------------------------------------------------------------------------
 -- Desugaring of non-linear patterns
@@ -351,45 +348,48 @@
 
 dsNonLinear :: NonLinearEnv -> Pattern PredType
             -> DsM (NonLinearEnv, Pattern PredType)
-dsNonLinear env l@(LiteralPattern        _ _) = return (env, l)
-dsNonLinear env n@(NegativePattern       _ _) = return (env, n)
-dsNonLinear env t@(VariablePattern       _ v)
+dsNonLinear env l@(LiteralPattern        _ _ _) = return (env, l)
+dsNonLinear env n@(NegativePattern       _ _ _) = return (env, n)
+dsNonLinear env t@(VariablePattern       _ _ v)
   | isAnonId v         = return (env, t)
   | v `Set.member` vis = do
     v' <- freshVar "_#nonlinear" t
-    return ((vis, mkStrictEquality v v' : eqs), uncurry VariablePattern v')
+    return ((vis, mkStrictEquality v v' : eqs),
+             uncurry (VariablePattern NoSpanInfo) v')
   | otherwise          = return ((Set.insert v vis, eqs), t)
   where (vis, eqs) = env
-dsNonLinear env (ConstructorPattern pty c ts) = second (ConstructorPattern pty c)
-                                                <$> mapAccumM dsNonLinear env ts
-dsNonLinear env (InfixPattern   pty t1 op t2) = do
+dsNonLinear env (ConstructorPattern _ pty c ts)
+  = second (ConstructorPattern NoSpanInfo pty c) <$> mapAccumM dsNonLinear env ts
+dsNonLinear env (InfixPattern   _ pty t1 op t2) = do
   (env1, t1') <- dsNonLinear env  t1
   (env2, t2') <- dsNonLinear env1 t2
-  return (env2, InfixPattern pty t1' op t2')
-dsNonLinear env (ParenPattern            t) = second ParenPattern
-                                              <$> dsNonLinear env t
-dsNonLinear env (RecordPattern      pty c fs) =
-  second (RecordPattern pty c) <$> mapAccumM (dsField dsNonLinear) env fs
-dsNonLinear env (TuplePattern             ts) = second TuplePattern
-                                                <$> mapAccumM dsNonLinear env ts
-dsNonLinear env (ListPattern          pty ts) = second (ListPattern pty)
-                                                <$> mapAccumM dsNonLinear env ts
-dsNonLinear env (AsPattern               v t) = do
+  return (env2, InfixPattern NoSpanInfo pty t1' op t2')
+dsNonLinear env (ParenPattern              _ t) =
+  second (ParenPattern NoSpanInfo) <$> dsNonLinear env t
+dsNonLinear env (RecordPattern      _ pty c fs) =
+  second (RecordPattern NoSpanInfo pty c)
+  <$> mapAccumM (dsField dsNonLinear) env fs
+dsNonLinear env (TuplePattern             _ ts) =
+  second (TuplePattern NoSpanInfo) <$> mapAccumM dsNonLinear env ts
+dsNonLinear env (ListPattern          _ pty ts) =
+  second (ListPattern NoSpanInfo pty) <$> mapAccumM dsNonLinear env ts
+dsNonLinear env (AsPattern               _ v t) = do
   let pty = predType $ typeOf t
-  (env1, VariablePattern _ v') <- dsNonLinear env (VariablePattern pty v)
+  (env1, VariablePattern _ _ v') <-
+    dsNonLinear env (VariablePattern NoSpanInfo pty v)
   (env2, t') <- dsNonLinear env1 t
-  return (env2, AsPattern v' t')
-dsNonLinear env (LazyPattern               t) = second LazyPattern
-                                                <$> dsNonLinear env t
-dsNonLinear env fp@(FunctionPattern    _ _ _) = dsNonLinearFuncPat env fp
-dsNonLinear env fp@(InfixFuncPattern _ _ _ _) = dsNonLinearFuncPat env fp
+  return (env2, AsPattern NoSpanInfo v' t')
+dsNonLinear env (LazyPattern               _ t) =
+  second (LazyPattern NoSpanInfo) <$> dsNonLinear env t
+dsNonLinear env fp@(FunctionPattern    _ _ _ _) = dsNonLinearFuncPat env fp
+dsNonLinear env fp@(InfixFuncPattern _ _ _ _ _) = dsNonLinearFuncPat env fp
 
 dsNonLinearFuncPat :: NonLinearEnv -> Pattern PredType
                    -> DsM (NonLinearEnv, Pattern PredType)
 dsNonLinearFuncPat (vis, eqs) fp = do
   let fpVars = map (\(v, _, pty) -> (pty, v)) $ patternVars fp
       vs     = filter ((`Set.member` vis) . snd) fpVars
-  vs' <- mapM (freshVar "_#nonlinear" . uncurry VariablePattern) vs
+  vs' <- mapM (freshVar "_#nonlinear" . uncurry (VariablePattern NoSpanInfo)) vs
   let vis' = foldr (Set.insert . snd) vis fpVars
       fp'  = substPat (zip (map snd vs) (map snd vs')) fp
   return ((vis', zipWith mkStrictEquality (map snd vs) vs' ++ eqs), fp')
@@ -398,28 +398,32 @@
 mkStrictEquality x (pty, y) = mkVar pty x =:= mkVar pty y
 
 substPat :: [(Ident, Ident)] -> Pattern a -> Pattern a
-substPat _ l@(LiteralPattern        _ _) = l
-substPat _ n@(NegativePattern       _ _) = n
-substPat s (VariablePattern         a v) = VariablePattern a
-                                         $ fromMaybe v (lookup v s)
-substPat s (ConstructorPattern   a c ps) = ConstructorPattern a c
-                                         $ map (substPat s) ps
-substPat s (InfixPattern     a p1 op p2) = InfixPattern a (substPat s p1) op
-                                                        (substPat s p2)
-substPat s (ParenPattern              p) = ParenPattern (substPat s p)
-substPat s (RecordPattern        a c fs) = RecordPattern a c (map substField fs)
+substPat _ l@(LiteralPattern        _ _ _) = l
+substPat _ n@(NegativePattern       _ _ _) = n
+substPat s (VariablePattern         _ a v) =
+  VariablePattern NoSpanInfo a $ fromMaybe v (lookup v s)
+
+substPat s (ConstructorPattern   _ a c ps) =
+  ConstructorPattern NoSpanInfo a c $ map (substPat s) ps
+substPat s (InfixPattern     _ a p1 op p2) =
+  InfixPattern NoSpanInfo a (substPat s p1) op (substPat s p2)
+substPat s (ParenPattern              _ p) =
+  ParenPattern NoSpanInfo (substPat s p)
+substPat s (RecordPattern        _ a c fs) =
+  RecordPattern NoSpanInfo a c (map substField fs)
   where substField (Field pos l pat) = Field pos l (substPat s pat)
-substPat s (TuplePattern             ps) = TuplePattern
-                                         $ map (substPat s) ps
-substPat s (ListPattern            a ps) = ListPattern a
-                                         $ map (substPat s) ps
-substPat s (AsPattern               v p) = AsPattern (fromMaybe v (lookup v s))
-                                                     (substPat s p)
-substPat s (LazyPattern               p) = LazyPattern (substPat s p)
-substPat s (FunctionPattern      a f ps) = FunctionPattern a f
-                                         $ map (substPat s) ps
-substPat s (InfixFuncPattern a p1 op p2) = InfixFuncPattern a (substPat s p1) op
-                                                            (substPat s p2)
+substPat s (TuplePattern             _ ps) =
+  TuplePattern NoSpanInfo $ map (substPat s) ps
+substPat s (ListPattern            _ a ps) =
+  ListPattern NoSpanInfo a $ map (substPat s) ps
+substPat s (AsPattern               _ v p) =
+  AsPattern NoSpanInfo (fromMaybe v (lookup v s)) (substPat s p)
+substPat s (LazyPattern               _ p) =
+  LazyPattern NoSpanInfo (substPat s p)
+substPat s (FunctionPattern      _ a f ps) =
+  FunctionPattern NoSpanInfo a f $ map (substPat s) ps
+substPat s (InfixFuncPattern _ a p1 op p2) =
+  InfixFuncPattern NoSpanInfo a (substPat s p1) op (substPat s p2)
 
 -- -----------------------------------------------------------------------------
 -- Desugaring of functional patterns
@@ -440,7 +444,7 @@
 --     such that the patterns are evaluated from left to right.
 
 dsFunctionalPatterns
-  :: Position -> [Pattern PredType]
+  :: SpanInfo -> [Pattern PredType]
   -> DsM ([Decl PredType], [Expression PredType], [Pattern PredType])
 dsFunctionalPatterns p ts = do
   -- extract functional patterns
@@ -454,32 +458,35 @@
 
 elimFP :: [LazyBinding] -> Pattern PredType
        -> DsM ([LazyBinding], Pattern PredType)
-elimFP bs p@(LiteralPattern        _ _) = return (bs, p)
-elimFP bs p@(NegativePattern       _ _) = return (bs, p)
-elimFP bs p@(VariablePattern       _ _) = return (bs, p)
-elimFP bs (ConstructorPattern pty c ts) = second (ConstructorPattern pty c)
-                                          <$> mapAccumM elimFP bs ts
-elimFP bs (InfixPattern   pty t1 op t2) = do
+elimFP bs p@(LiteralPattern        _ _ _) = return (bs, p)
+elimFP bs p@(NegativePattern       _ _ _) = return (bs, p)
+elimFP bs p@(VariablePattern       _ _ _) = return (bs, p)
+elimFP bs (ConstructorPattern _ pty c ts) =
+  second (ConstructorPattern NoSpanInfo  pty c) <$> mapAccumM elimFP bs ts
+elimFP bs (InfixPattern   _ pty t1 op t2) = do
   (bs1, t1') <- elimFP bs  t1
   (bs2, t2') <- elimFP bs1 t2
-  return (bs2, InfixPattern pty t1' op t2')
-elimFP bs (ParenPattern              t) = second ParenPattern <$> elimFP bs t
-elimFP bs (RecordPattern      pty c fs) = second (RecordPattern pty c)
-                                          <$> mapAccumM (dsField elimFP) bs fs
-elimFP bs (TuplePattern             ts) = second TuplePattern
-                                          <$> mapAccumM elimFP bs ts
-elimFP bs (ListPattern          pty ts) = second (ListPattern pty)
-                                          <$> mapAccumM elimFP bs ts
-elimFP bs (AsPattern               v t) = second (AsPattern   v) <$> elimFP bs t
-elimFP bs (LazyPattern               t) = second LazyPattern <$> elimFP bs t
-elimFP bs p@(FunctionPattern     _ _ _) = do
+  return (bs2, InfixPattern NoSpanInfo pty t1' op t2')
+elimFP bs (ParenPattern              _ t) =
+  second (ParenPattern NoSpanInfo) <$> elimFP bs t
+elimFP bs (RecordPattern      _ pty c fs) =
+  second (RecordPattern NoSpanInfo pty c) <$> mapAccumM (dsField elimFP) bs fs
+elimFP bs (TuplePattern             _ ts) =
+  second (TuplePattern NoSpanInfo) <$> mapAccumM elimFP bs ts
+elimFP bs (ListPattern          _ pty ts) =
+  second (ListPattern NoSpanInfo pty) <$> mapAccumM elimFP bs ts
+elimFP bs (AsPattern               _ v t) =
+  second (AsPattern NoSpanInfo v) <$> elimFP bs t
+elimFP bs (LazyPattern               _ t) =
+  second (LazyPattern NoSpanInfo) <$> elimFP bs t
+elimFP bs p@(FunctionPattern    _  _ _ _) = do
  (pty, v) <- freshVar "_#funpatt" p
- return ((p, (pty, v)) : bs, VariablePattern pty v)
-elimFP bs p@(InfixFuncPattern  _ _ _ _) = do
+ return ((p, (pty, v)) : bs, VariablePattern NoSpanInfo pty v)
+elimFP bs p@(InfixFuncPattern  _ _ _ _ _) = do
  (pty, v) <- freshVar "_#funpatt" p
- return ((p, (pty, v)) : bs, VariablePattern pty v)
+ return ((p, (pty, v)) : bs, VariablePattern NoSpanInfo pty v)
 
-genFPExpr :: Position -> [(Ident, Int, PredType)] -> [LazyBinding]
+genFPExpr :: SpanInfo -> [(Ident, Int, PredType)] -> [LazyBinding]
           -> ([Decl PredType], [Expression PredType])
 genFPExpr p vs bs
   | null bs   = ([]               , [])
@@ -493,42 +500,43 @@
                  concatMap patternVars (map fst bs) \\ vs
 
 fp2Expr :: Pattern PredType -> (Expression PredType, [Expression PredType])
-fp2Expr (LiteralPattern          pty l) = (Literal pty l, [])
-fp2Expr (NegativePattern         pty l) = (Literal pty (negateLiteral l), [])
-fp2Expr (VariablePattern         pty v) = (mkVar pty v, [])
-fp2Expr (ConstructorPattern   pty c ts) =
+fp2Expr (LiteralPattern          _ pty l) = (Literal NoSpanInfo  pty l, [])
+fp2Expr (NegativePattern         _ pty l) =
+  (Literal NoSpanInfo pty (negateLiteral l), [])
+fp2Expr (VariablePattern         _ pty v) = (mkVar pty v, [])
+fp2Expr (ConstructorPattern  _  pty c ts) =
   let (ts', ess) = unzip $ map fp2Expr ts
       pty' = predType $ foldr TypeArrow (unpredType pty) $ map typeOf ts
-  in  (apply (Constructor pty' c) ts', concat ess)
-fp2Expr (InfixPattern   pty t1 op t2) =
+  in  (apply (Constructor NoSpanInfo pty' c) ts', concat ess)
+fp2Expr (InfixPattern   _ pty t1 op t2) =
   let (t1', es1) = fp2Expr t1
       (t2', es2) = fp2Expr t2
       pty' = predType $ foldr TypeArrow (unpredType pty) [typeOf t1, typeOf t2]
-  in  (InfixApply t1' (InfixConstr pty' op) t2', es1 ++ es2)
-fp2Expr (ParenPattern                t) = first Paren (fp2Expr t)
-fp2Expr (TuplePattern               ts) =
+  in  (InfixApply NoSpanInfo t1' (InfixConstr pty' op) t2', es1 ++ es2)
+fp2Expr (ParenPattern                _ t) = first (Paren NoSpanInfo) (fp2Expr t)
+fp2Expr (TuplePattern               _ ts) =
   let (ts', ess) = unzip $ map fp2Expr ts
-  in  (Tuple ts', concat ess)
-fp2Expr (ListPattern            pty ts) =
+  in  (Tuple NoSpanInfo ts', concat ess)
+fp2Expr (ListPattern            _ pty ts) =
   let (ts', ess) = unzip $ map fp2Expr ts
-  in  (List pty ts', concat ess)
-fp2Expr (FunctionPattern      pty f ts) =
+  in  (List NoSpanInfo pty ts', concat ess)
+fp2Expr (FunctionPattern      _ pty f ts) =
   let (ts', ess) = unzip $ map fp2Expr ts
       pty' = predType $ foldr TypeArrow (unpredType pty) $ map typeOf ts
-  in  (apply (Variable pty' f) ts', concat ess)
-fp2Expr (InfixFuncPattern pty t1 op t2) =
+  in  (apply (Variable NoSpanInfo pty' f) ts', concat ess)
+fp2Expr (InfixFuncPattern _ pty t1 op t2) =
   let (t1', es1) = fp2Expr t1
       (t2', es2) = fp2Expr t2
       pty' = predType $ foldr TypeArrow (unpredType pty) $ map typeOf [t1, t2]
-  in  (InfixApply t1' (InfixOp pty' op) t2', es1 ++ es2)
-fp2Expr (AsPattern                 v t) =
+  in  (InfixApply NoSpanInfo t1' (InfixOp pty' op) t2', es1 ++ es2)
+fp2Expr (AsPattern                 _ v t) =
   let (t', es) = fp2Expr t
       pty = predType $ typeOf t
   in  (mkVar pty v, (t' =:<= mkVar pty v) : es)
-fp2Expr (RecordPattern        pty c fs) =
+fp2Expr (RecordPattern        _ pty c fs) =
   let (fs', ess) = unzip [ (Field p f e, es) | Field p f t <- fs
                                              , let (e, es) = fp2Expr t]
-  in  (Record pty c fs', concat ess)
+  in  (Record NoSpanInfo pty c fs', concat ess)
 fp2Expr t                               = internalError $
   "Desugar.fp2Expr: Unexpected constructor term: " ++ show t
 
@@ -558,71 +566,74 @@
 
 dsLiteralPat :: PredType -> Literal
              -> Either (Pattern PredType) (Pattern PredType)
-dsLiteralPat pty c@(Char _) = Right (LiteralPattern pty c)
+dsLiteralPat pty c@(Char _) = Right (LiteralPattern NoSpanInfo pty c)
 dsLiteralPat pty (Int i) =
-  Right (LiteralPattern pty (fixLiteral (unpredType pty)))
+  Right (LiteralPattern NoSpanInfo pty (fixLiteral (unpredType pty)))
   where fixLiteral (TypeConstrained tys _) = fixLiteral (head tys)
         fixLiteral ty
           | ty == floatType = Float $ fromInteger i
           | otherwise = Int i
-dsLiteralPat pty f@(Float _) = Right (LiteralPattern pty f)
+dsLiteralPat pty f@(Float _) = Right (LiteralPattern NoSpanInfo pty f)
 dsLiteralPat pty (String cs) =
-  Left $ ListPattern pty $ map (LiteralPattern pty' . Char) cs
+  Left $ ListPattern NoSpanInfo pty $
+  map (LiteralPattern NoSpanInfo pty' . Char) cs
   where pty' = predType $ elemType $ unpredType pty
 
-dsPat :: Position -> [Decl PredType] -> Pattern PredType
+dsPat :: SpanInfo -> [Decl PredType] -> Pattern PredType
       -> DsM ([Decl PredType], Pattern PredType)
-dsPat _ ds v@(VariablePattern     _ _) = return (ds, v)
-dsPat p ds (LiteralPattern      pty l) =
+dsPat _ ds v@(VariablePattern       _ _ _) = return (ds, v)
+dsPat p ds (LiteralPattern      _ pty l) =
   either (dsPat p ds) (return . (,) ds) (dsLiteralPat pty l)
-dsPat p ds (NegativePattern     pty l) =
-  dsPat p ds (LiteralPattern pty (negateLiteral l))
-dsPat p ds (ConstructorPattern pty c ts) =
-  second (ConstructorPattern pty c) <$> mapAccumM (dsPat p) ds ts
-dsPat p ds (InfixPattern  pty t1 op t2) =
-  dsPat p ds (ConstructorPattern pty op [t1, t2])
-dsPat p ds (ParenPattern           t) = dsPat p ds t
-dsPat p ds (RecordPattern   pty c fs) = do
+dsPat p ds (NegativePattern       _ pty l) =
+  dsPat p ds (LiteralPattern NoSpanInfo pty (negateLiteral l))
+dsPat p ds (ConstructorPattern _ pty c ts) =
+  second (ConstructorPattern NoSpanInfo pty c) <$> mapAccumM (dsPat p) ds ts
+dsPat p ds (InfixPattern   _ pty t1 op t2) =
+  dsPat p ds (ConstructorPattern NoSpanInfo pty op [t1, t2])
+dsPat p ds (ParenPattern              _ t) = dsPat p ds t
+dsPat p ds (RecordPattern      _ pty c fs) = do
   vEnv <- getValueEnv
   --TODO: Rework
   let (ls, tys) = argumentTypes (unpredType pty) c vEnv
       tsMap = map field2Tuple fs
-      anonTs = map (flip VariablePattern anonId . predType) tys
-      maybeTs = map (flip lookup tsMap) ls
+  anonTs <- mapM ((uncurry (VariablePattern NoSpanInfo) <$>) .
+                  freshVar "_#recpat") tys
+  let maybeTs = map (flip lookup tsMap) ls
       ts = zipWith fromMaybe anonTs maybeTs
-  dsPat p ds (ConstructorPattern pty c ts)
-dsPat p ds (TuplePattern          ts) =
-  dsPat p ds (ConstructorPattern pty (qTupleId $ length ts) ts)
+  dsPat p ds (ConstructorPattern NoSpanInfo pty c ts)
+dsPat p ds (TuplePattern              _ ts) =
+  dsPat p ds (ConstructorPattern NoSpanInfo pty (qTupleId $ length ts) ts)
   where pty = predType (tupleType (map typeOf ts))
-dsPat p ds (ListPattern       pty ts) =
+dsPat p ds (ListPattern           _ pty ts) =
   second (dsList cons nil) <$> mapAccumM (dsPat p) ds ts
-  where nil = ConstructorPattern pty qNilId []
-        cons t ts' = ConstructorPattern pty qConsId [t, ts']
-dsPat p ds (AsPattern            v t) = dsAs p v <$> dsPat p ds t
-dsPat p ds (LazyPattern            t) = dsLazy p ds t
-dsPat p ds (FunctionPattern    pty f ts) = second (FunctionPattern pty f)
-                                        <$> mapAccumM (dsPat p) ds ts
-dsPat p ds (InfixFuncPattern pty t1 f t2) =
-  dsPat p ds (FunctionPattern pty f [t1, t2])
+  where nil = ConstructorPattern NoSpanInfo pty qNilId []
+        cons t ts' = ConstructorPattern NoSpanInfo pty qConsId [t, ts']
+dsPat p ds (AsPattern            _ v t) = dsAs p v <$> dsPat p ds t
+dsPat p ds (LazyPattern            _ t) = dsLazy p ds t
+dsPat p ds (FunctionPattern   _   pty f ts) =
+  second (FunctionPattern NoSpanInfo pty f) <$> mapAccumM (dsPat p) ds ts
+dsPat p ds (InfixFuncPattern _ pty t1 f t2) =
+  dsPat p ds (FunctionPattern NoSpanInfo pty f [t1, t2])
 
-dsAs :: Position -> Ident -> ([Decl PredType], Pattern PredType)
+dsAs :: SpanInfo -> Ident -> ([Decl PredType], Pattern PredType)
      -> ([Decl PredType], Pattern PredType)
 dsAs p v (ds, t) = case t of
-  VariablePattern pty v' -> (varDecl p pty v (mkVar pty v') : ds, t)
-  AsPattern        v' t' -> (varDecl p pty' v (mkVar pty' v') : ds, t)
+  VariablePattern _ pty v' -> (varDecl p pty  v (mkVar pty  v') : ds,t)
+  AsPattern       _  v' t' -> (varDecl p pty' v (mkVar pty' v') : ds,t)
     where pty' = predType $ typeOf t'
-  _                      -> (ds, AsPattern v t)
+  _                      -> (ds, AsPattern NoSpanInfo v t)
 
-dsLazy :: Position -> [Decl PredType] -> Pattern PredType
+dsLazy :: SpanInfo -> [Decl PredType] -> Pattern PredType
        -> DsM ([Decl PredType], Pattern PredType)
 dsLazy p ds t = case t of
-  VariablePattern _ _ -> return (ds, t)
-  ParenPattern   t' -> dsLazy p ds t'
-  AsPattern    v t' -> dsAs p v <$> dsLazy p ds t'
-  LazyPattern    t' -> dsLazy p ds t'
+  VariablePattern _ _ _ -> return (ds, t)
+  ParenPattern     _ t' -> dsLazy p ds t'
+  AsPattern      _ v t' -> dsAs p v <$> dsLazy p ds t'
+  LazyPattern      _ t' -> dsLazy p ds t'
   _                 -> do
     (pty, v') <- freshVar "_#lazy" t
-    return (patDecl p t (mkVar pty v') : ds, VariablePattern pty v')
+    return (patDecl NoSpanInfo t (mkVar pty v') : ds,
+            VariablePattern NoSpanInfo pty v')
 
 {-
 -- -----------------------------------------------------------------------------
@@ -641,16 +652,17 @@
 -- field labels @l_1,...,l_k@. In contrast to Haskell, we do not report
 -- an error if this is not the case, but call failed instead.
 -}
-dsExpr :: Position -> Expression PredType -> DsM (Expression PredType)
-dsExpr p (Literal     pty l) =
+dsExpr :: SpanInfo -> Expression PredType -> DsM (Expression PredType)
+dsExpr p (Literal     _ pty l) =
   either (dsExpr p) return (dsLiteral pty l)
-dsExpr _ var@(Variable pty v)
+dsExpr _ var@(Variable _ pty v)
   | isAnonId (unqualify v)   = return $ prelUnknown $ unpredType pty
   | otherwise                = return var
-dsExpr _ c@(Constructor _ _) = return c
-dsExpr p (Paren           e) = dsExpr p e
-dsExpr p (Typed       e qty) = Typed <$> dsExpr p e <*> dsQualTypeExpr qty
-dsExpr p (Record   pty c fs) = do
+dsExpr _ c@(Constructor _ _ _) = return c
+dsExpr p (Paren           _ e) = dsExpr p e
+dsExpr p (Typed       _ e qty) = Typed NoSpanInfo
+  <$> dsExpr p e <*> dsQualTypeExpr qty
+dsExpr p (Record   _ pty c fs) = do
   vEnv <- getValueEnv
   --TODO: Rework
   let (ls, tys) = argumentTypes (unpredType pty) c vEnv
@@ -659,9 +671,9 @@
       maybeEs = map (flip lookup esMap) ls
       es = zipWith fromMaybe unknownEs maybeEs
   dsExpr p (applyConstr pty c tys es)
-dsExpr p (RecordUpdate e fs) = do
+dsExpr p (RecordUpdate _ e fs) = do
   alts  <- constructors tc >>= concatMapM updateAlt
-  dsExpr p $ Case Flex e (map (uncurry (caseAlt p)) alts)
+  dsExpr p $ Case NoSpanInfo Flex e (map (uncurry (caseAlt p)) alts)
   where ty = typeOf e
         pty = predType ty
         tc = rootOfType (arrowBase ty)
@@ -679,53 +691,61 @@
             return [(pat, applyConstr pty qc tys es)]
           where qls2 = map (qualifyLike tc) ls
         updateAlt _ = return []
-dsExpr p (Tuple      es) = apply (Constructor pty $ qTupleId $ length es) <$> mapM (dsExpr p) es
+dsExpr p (Tuple      _ es) =
+  apply (Constructor NoSpanInfo pty $ qTupleId $ length es)
+  <$> mapM (dsExpr p) es
   where pty = predType (foldr TypeArrow (tupleType tys) tys)
         tys = map typeOf es
-dsExpr p (List   pty es) = dsList cons nil <$> mapM (dsExpr p) es
-  where nil = Constructor pty qNilId
-        cons = Apply . Apply (Constructor (predType $ consType $ elemType $ unpredType pty) qConsId)
-dsExpr p (ListCompr          e qs) = dsListComp p e qs
-dsExpr p (EnumFrom              e) = Apply (prelEnumFrom (typeOf e))
-                                     <$> dsExpr p e
-dsExpr p (EnumFromThen      e1 e2) = apply (prelEnumFromThen (typeOf e1))
-                                     <$> mapM (dsExpr p) [e1, e2]
-dsExpr p (EnumFromTo        e1 e2) = apply (prelEnumFromTo (typeOf e1))
-                                     <$> mapM (dsExpr p) [e1, e2]
-dsExpr p (EnumFromThenTo e1 e2 e3) = apply (prelEnumFromThenTo (typeOf e1))
-                                     <$> mapM (dsExpr p) [e1, e2, e3]
-dsExpr p (UnaryMinus            e) = do
+dsExpr p (List   _ pty es) = dsList cons nil <$> mapM (dsExpr p) es
+  where nil = Constructor NoSpanInfo pty qNilId
+        cons = (Apply NoSpanInfo) . (Apply NoSpanInfo)
+          (Constructor NoSpanInfo
+            (predType $ consType $ elemType $ unpredType pty) qConsId)
+dsExpr p (ListCompr          _ e qs) = dsListComp p e qs
+dsExpr p (EnumFrom              _ e) =
+  Apply NoSpanInfo (prelEnumFrom (typeOf e)) <$> dsExpr p e
+dsExpr p (EnumFromThen      _ e1 e2) =
+  apply (prelEnumFromThen (typeOf e1)) <$> mapM (dsExpr p) [e1, e2]
+dsExpr p (EnumFromTo        _ e1 e2) = apply (prelEnumFromTo (typeOf e1))
+                                    <$> mapM (dsExpr p) [e1, e2]
+dsExpr p (EnumFromThenTo _ e1 e2 e3) = apply (prelEnumFromThenTo (typeOf e1))
+                                    <$> mapM (dsExpr p) [e1, e2, e3]
+dsExpr p (UnaryMinus            _ e) = do
   e' <- dsExpr p e
   negativeLitsEnabled <- checkNegativeLitsExtension
   return $ case e' of
-    Literal pty l | negativeLitsEnabled -> Literal pty $ negateLiteral l
-    _                                   -> Apply (prelNegate $ typeOf e') e'
-dsExpr p (Apply e1 e2) = Apply <$> dsExpr p e1 <*> dsExpr p e2
-dsExpr p (InfixApply e1 op e2) = do
+    Literal _ pty l | negativeLitsEnabled ->
+      Literal NoSpanInfo pty $ negateLiteral l
+    _                                     ->
+      Apply NoSpanInfo (prelNegate $ typeOf e') e'
+dsExpr p (Apply _ e1 e2) = Apply NoSpanInfo <$> dsExpr p e1 <*> dsExpr p e2
+dsExpr p (InfixApply _ e1 op e2) = do
   op' <- dsExpr p (infixOp op)
   e1' <- dsExpr p e1
   e2' <- dsExpr p e2
   return $ apply op' [e1', e2']
-dsExpr p (LeftSection  e op) = Apply <$> dsExpr p (infixOp op) <*> dsExpr p e
-dsExpr p (RightSection op e) = do
+dsExpr p (LeftSection  _ e op) =
+  Apply NoSpanInfo <$> dsExpr p (infixOp op) <*> dsExpr p e
+dsExpr p (RightSection _ op e) = do
   op' <- dsExpr p (infixOp op)
   e'  <- dsExpr p e
   return $ apply (prelFlip ty1 ty2 ty3) [op', e']
   where TypeArrow ty1 (TypeArrow ty2 ty3) = typeOf (infixOp op)
-dsExpr p expr@(Lambda ts e) = do
+dsExpr p expr@(Lambda _ ts e) = do
   (pty, f) <- freshVar "_#lambda" expr
-  dsExpr p $ Let [funDecl NoPos pty f ts e] $ mkVar pty f
-dsExpr p (Let ds e) = do
+  dsExpr p $ Let NoSpanInfo [funDecl p pty f ts e] $ mkVar pty f
+dsExpr p (Let _ ds e) = do
   ds' <- dsDeclGroup ds
   e'  <- dsExpr p e
-  return (if null ds' then e' else Let ds' e')
-dsExpr p (Do              sts e) = dsDo sts e >>= dsExpr p
-dsExpr p (IfThenElse e1 e2 e3) = do
+  return (if null ds' then e' else Let NoSpanInfo ds' e')
+dsExpr p (Do              _ sts e) = dsDo sts e >>= dsExpr p
+dsExpr p (IfThenElse _ e1 e2 e3) = do
   e1' <- dsExpr p e1
   e2' <- dsExpr p e2
   e3' <- dsExpr p e3
-  return $ Case Rigid e1' [caseAlt p truePat e2', caseAlt p falsePat e3']
-dsExpr p (Case ct e alts) = dsCase p ct e alts
+  return $ Case NoSpanInfo Rigid e1'
+             [caseAlt p truePat e2', caseAlt p falsePat e3']
+dsExpr p (Case _ ct e alts) = dsCase p ct e alts
 
 -- We ignore the context in the type signature of a typed expression, since
 -- there should be no possibility to provide an non-empty context without
@@ -733,7 +753,8 @@
 -- TODO: Verify
 
 dsQualTypeExpr :: QualTypeExpr -> DsM QualTypeExpr
-dsQualTypeExpr (QualTypeExpr cx ty) = QualTypeExpr cx <$> dsTypeExpr ty
+dsQualTypeExpr (QualTypeExpr _ cx ty) =
+  QualTypeExpr NoSpanInfo cx <$> dsTypeExpr ty
 
 dsTypeExpr :: TypeExpr -> DsM TypeExpr
 dsTypeExpr ty = do
@@ -753,7 +774,7 @@
 -- such that it evaluates a case expression with the remaining cases that
 -- are compatible with the matched pattern when the guards fail.
 
-dsCase :: Position -> CaseType -> Expression PredType -> [Alt PredType]
+dsCase :: SpanInfo -> CaseType -> Expression PredType -> [Alt PredType]
        -> DsM (Expression PredType)
 dsCase p ct e alts
   | null alts = internalError "Desugar.dsCase: empty list of alternatives"
@@ -766,8 +787,9 @@
     return (mkCase m v e' alts'')
   where
   mkCase m (pty, v) e' bs
-    | v `elem` qfv m bs = Let [varDecl p pty v e'] (Case ct (mkVar pty v) bs)
-    | otherwise         = Case ct e' bs
+    | v `elem` qfv m bs = Let NoSpanInfo [varDecl p pty v e']
+                          (Case NoSpanInfo ct (mkVar pty v) bs)
+    | otherwise         = Case NoSpanInfo ct e' bs
 
 dsAltLhs :: Alt PredType -> DsM (Alt PredType)
 dsAltLhs (Alt p t rhs) = do
@@ -775,7 +797,7 @@
   return $ Alt p t' (addDecls ds' rhs)
 
 dsAltRhs :: Alt PredType -> DsM (Alt PredType)
-dsAltRhs (Alt p t rhs) = Alt p t <$> dsRhs p id rhs
+dsAltRhs (Alt p t rhs) = Alt p t <$> dsRhs id rhs
 
 expandAlt :: (PredType, Ident) -> CaseType -> [Alt PredType]
           -> DsM (Alt PredType)
@@ -783,18 +805,18 @@
 expandAlt v ct (Alt p t rhs : alts) = caseAlt p t <$> expandRhs e0 id rhs
   where
   e0 | ct == Flex || null compAlts = prelFailed (typeOf rhs)
-     | otherwise = Case ct (uncurry mkVar v) compAlts
+     | otherwise = Case NoSpanInfo ct (uncurry mkVar v) compAlts
   compAlts = filter (isCompatible t . altPattern) alts
   altPattern (Alt _ t1 _) = t1
 
 isCompatible :: Pattern a -> Pattern a -> Bool
-isCompatible (VariablePattern _ _) _ = True
-isCompatible _ (VariablePattern _ _) = True
-isCompatible (AsPattern _ t1) t2 = isCompatible t1 t2
-isCompatible t1 (AsPattern _ t2) = isCompatible t1 t2
-isCompatible (ConstructorPattern _ c1 ts1) (ConstructorPattern _ c2 ts2)
+isCompatible (VariablePattern _ _ _) _ = True
+isCompatible _ (VariablePattern _ _ _) = True
+isCompatible (AsPattern _ _ t1) t2 = isCompatible t1 t2
+isCompatible t1 (AsPattern _ _ t2) = isCompatible t1 t2
+isCompatible (ConstructorPattern _ _ c1 ts1) (ConstructorPattern _ _ c2 ts2)
   = and ((c1 == c2) : zipWith isCompatible ts1 ts2)
-isCompatible (LiteralPattern _ l1) (LiteralPattern _ l2) = l1 == l2
+isCompatible (LiteralPattern _ _ l1) (LiteralPattern _ _ l2) = l1 == l2
 isCompatible _ _ = False
 
 -- -----------------------------------------------------------------------------
@@ -813,21 +835,21 @@
 dsDo sts e = foldrM dsStmt e sts
 
 dsStmt :: Statement PredType -> Expression PredType -> DsM (Expression PredType)
-dsStmt (StmtExpr   e1) e' =
+dsStmt (StmtExpr   _ e1) e' =
   return $ apply (prelBind_ (typeOf e1) (typeOf e')) [e1, e']
-dsStmt (StmtBind t e1) e' = do
+dsStmt (StmtBind _ t e1) e' = do
   v <- freshVar "_#var" t
-  let func = Lambda [uncurry VariablePattern v] $
-               Case Rigid (uncurry mkVar v)
-                 [ caseAlt NoPos t e'
-                 , caseAlt NoPos (uncurry VariablePattern v)
+  let func = Lambda NoSpanInfo [uncurry (VariablePattern NoSpanInfo) v] $
+               Case NoSpanInfo Rigid (uncurry mkVar v)
+                 [ caseAlt NoSpanInfo t e'
+                 , caseAlt NoSpanInfo (uncurry (VariablePattern NoSpanInfo) v)
                      (failedPatternMatch $ typeOf e')
                  ]
   return $ apply (prelBind (typeOf e1) (typeOf t) (typeOf e')) [e1, func]
   where failedPatternMatch ty =
           apply (prelFail ty)
-            [Literal predStringType $ String "Pattern match failed!"]
-dsStmt (StmtDecl   ds) e' = return $ Let ds e'
+            [Literal NoSpanInfo predStringType $ String "Pattern match failed!"]
+dsStmt (StmtDecl   _ ds) e' = return $ Let NoSpanInfo ds e'
 
 -- -----------------------------------------------------------------------------
 -- Desugaring of List Comprehensions
@@ -859,38 +881,42 @@
 -- avoid the construction of the singleton list by calling '(:)'
 -- instead of '(++)' and 'map' in place of 'concatMap', respectively.
 
-dsListComp :: Position -> Expression PredType -> [Statement PredType]
+dsListComp :: SpanInfo -> Expression PredType -> [Statement PredType]
            -> DsM (Expression PredType)
 dsListComp p e []     =
-  dsExpr p (List (predType $ listType $ typeOf e) [e])
-dsListComp p e (q:qs) = dsQual p q (ListCompr e qs)
+  dsExpr p (List NoSpanInfo (predType $ listType $ typeOf e) [e])
+dsListComp p e (q:qs) = dsQual p q (ListCompr NoSpanInfo e qs)
 
-dsQual :: Position -> Statement PredType -> Expression PredType
+dsQual :: SpanInfo -> Statement PredType -> Expression PredType
        -> DsM (Expression PredType)
-dsQual p (StmtExpr   b) e =
-  dsExpr p (IfThenElse b e (List (predType $ typeOf e) []))
-dsQual p (StmtDecl  ds) e = dsExpr p (Let ds e)
-dsQual p (StmtBind t l) e
+dsQual p (StmtExpr   _ b) e =
+  dsExpr p (IfThenElse NoSpanInfo b e (List NoSpanInfo (predType $ typeOf e) []))
+dsQual p (StmtDecl  _ ds) e = dsExpr p (Let NoSpanInfo ds e)
+dsQual p (StmtBind _ t l) e
   | isVariablePattern t = dsExpr p (qualExpr t e l)
   | otherwise = do
     v <- freshVar "_#var" t
     l' <- freshVar "_#var" e
     dsExpr p (apply (prelFoldr (typeOf t) (typeOf e))
-      [foldFunct v l' e, List (predType $ typeOf e) [], l])
+      [foldFunct v l' e, List NoSpanInfo (predType $ typeOf e) [], l])
   where
-  qualExpr v (ListCompr e1 []) l1
-    = apply (prelMap (typeOf v) (typeOf e1)) [Lambda [v] e1, l1]
+  qualExpr v (ListCompr NoSpanInfo e1 []) l1
+    = apply (prelMap (typeOf v) (typeOf e1)) [Lambda NoSpanInfo [v] e1, l1]
   qualExpr v e1                  l1
-    = apply (prelConcatMap (typeOf v) (elemType $ typeOf e1)) [Lambda [v] e1, l1]
+    = apply (prelConcatMap (typeOf v) (elemType $ typeOf e1))
+      [Lambda NoSpanInfo [v] e1, l1]
   foldFunct v l1 e1
-    = Lambda (map (uncurry VariablePattern) [v, l1])
-       (Case Rigid (uncurry mkVar v)
+    = Lambda NoSpanInfo (map (uncurry (VariablePattern NoSpanInfo)) [v, l1])
+       (Case NoSpanInfo Rigid (uncurry mkVar v)
           [ caseAlt p t (append e1 (uncurry mkVar l1))
-          , caseAlt p (uncurry VariablePattern v) (uncurry mkVar l1)])
+          , caseAlt p (uncurry (VariablePattern NoSpanInfo) v)
+                                    (uncurry mkVar l1)])
 
-  append (ListCompr e1 []) l1 = apply (prelCons (typeOf e1)) [e1, l1]
-  append e1                l1 = apply (prelAppend (elemType $ typeOf e1)) [e1, l1]
-  prelCons ty                 = Constructor (predType $ consType ty) $ qConsId
+  append (ListCompr _ e1 []) l1 = apply (prelCons (typeOf e1)) [e1, l1]
+  append e1                  l1 =
+    apply (prelAppend (elemType $ typeOf e1)) [e1, l1]
+  prelCons ty                   =
+      Constructor NoSpanInfo (predType $ consType ty) $ qConsId
 
 -- -----------------------------------------------------------------------------
 -- Desugaring of Lists, labels, fields, and literals
@@ -903,26 +929,26 @@
 --dsLabel def fs l = fromMaybe def (lookup l fs)
 
 dsField :: (a -> b -> DsM (a, b)) -> a -> Field b -> DsM (a, Field b)
-dsField ds z (Field p l x) = second (Field p l) <$> (ds z x)
+dsField ds z (Field p l x) = second (Field p l) <$> ds z x
 
 dsLiteral :: PredType -> Literal
           -> Either (Expression PredType) (Expression PredType)
-dsLiteral pty (Char c) = Right $ Literal pty $ Char c
+dsLiteral pty (Char c) = Right $ Literal NoSpanInfo pty $ Char c
 dsLiteral pty (Int i) = Right $ fixLiteral (unpredType pty)
   where fixLiteral (TypeConstrained tys _) = fixLiteral (head tys)
         fixLiteral ty
-          | ty == intType = Literal pty $ Int i
-          | ty == floatType = Literal pty $ Float $ fromInteger i
-          | otherwise = Apply (prelFromInt $ unpredType pty) $
-                          Literal predIntType $ Int i
+          | ty == intType = Literal NoSpanInfo pty $ Int i
+          | ty == floatType = Literal NoSpanInfo pty $ Float $ fromInteger i
+          | otherwise = Apply NoSpanInfo (prelFromInt $ unpredType pty) $
+                          Literal NoSpanInfo predIntType $ Int i
 dsLiteral pty f@(Float _) = Right $ fixLiteral (unpredType pty)
   where fixLiteral (TypeConstrained tys _) = fixLiteral (head tys)
         fixLiteral ty
-          | ty == floatType = Literal pty f
-          | otherwise = Apply (prelFromFloat $ unpredType pty) $
-                          Literal predFloatType f
+          | ty == floatType = Literal NoSpanInfo pty f
+          | otherwise = Apply NoSpanInfo (prelFromFloat $ unpredType pty) $
+                          Literal NoSpanInfo predFloatType f
 dsLiteral pty (String cs) =
-  Left $ List pty $ map (Literal pty' . Char) cs
+  Left $ List NoSpanInfo pty $ map (Literal NoSpanInfo pty' . Char) cs
   where pty' = predType $ elemType $ unpredType pty
 
 negateLiteral :: Literal -> Literal
@@ -935,7 +961,8 @@
 -- ---------------------------------------------------------------------------
 
 preludeFun :: [Type] -> Type -> String -> Expression PredType
-preludeFun tys ty = Variable (predType $ foldr TypeArrow ty tys) . preludeIdent
+preludeFun tys ty = Variable NoSpanInfo (predType $ foldr TypeArrow ty tys)
+                  . preludeIdent
 
 preludeIdent :: String -> QualIdent
 preludeIdent = qualifyWith preludeMIdent . mkIdent
@@ -1006,10 +1033,10 @@
 e1 & e2 = apply (preludeFun [boolType, boolType] boolType "&") [e1, e2]
 
 truePat :: Pattern PredType
-truePat = ConstructorPattern predBoolType qTrueId []
+truePat = ConstructorPattern NoSpanInfo predBoolType qTrueId []
 
 falsePat :: Pattern PredType
-falsePat = ConstructorPattern predBoolType qFalseId []
+falsePat = ConstructorPattern NoSpanInfo predBoolType qFalseId []
 
 -- ---------------------------------------------------------------------------
 -- Auxiliary definitions
@@ -1034,7 +1061,8 @@
 applyConstr :: PredType -> QualIdent -> [Type] -> [Expression PredType]
             -> Expression PredType
 applyConstr pty c tys =
-  apply (Constructor (predType (foldr TypeArrow (unpredType pty) tys)) c)
+  apply (Constructor NoSpanInfo
+    (predType (foldr TypeArrow (unpredType pty) tys)) c)
 
 -- The function 'instType' instantiates the universally quantified
 -- type variables of a type scheme with fresh type variables. Since this
diff --git a/src/Transformations/Dictionary.hs b/src/Transformations/Dictionary.hs
--- a/src/Transformations/Dictionary.hs
+++ b/src/Transformations/Dictionary.hs
@@ -36,6 +36,7 @@
 
 import Curry.Base.Ident
 import Curry.Base.Position
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.CurryTypes
@@ -72,7 +73,7 @@
 insertDicts :: InterfaceEnv -> TCEnv -> ValueEnv -> ClassEnv -> InstEnv
             -> OpPrecEnv -> Module PredType
             -> (Module Type, InterfaceEnv, TCEnv, ValueEnv, OpPrecEnv)
-insertDicts intfEnv tcEnv vEnv clsEnv inEnv pEnv mdl@(Module _ m _ _ _) =
+insertDicts intfEnv tcEnv vEnv clsEnv inEnv pEnv mdl@(Module _ _ m _ _ _) =
   (mdl', intfEnv', tcEnv', vEnv', pEnv')
   where initState =
           DTState m tcEnv vEnv clsEnv inEnv pEnv emptyAugEnv emptyDictEnv emptySpEnv 1
@@ -212,13 +213,13 @@
   augment :: a PredType -> DTM (a PredType)
 
 instance Augment Module where
-  augment (Module ps m es is ds) = do
+  augment (Module spi ps m es is ds) = do
     augEnv <- initAugEnv <$> getValueEnv
     setAugEnv augEnv
     modifyValueEnv $ augmentValues
     modifyTyConsEnv $ augmentTypes
     modifyInstEnv $ augmentInstances augEnv
-    Module ps m es is <$> mapM (augmentDecl Nothing) ds
+    Module spi ps m es is <$> mapM (augmentDecl Nothing) ds
 
 -- The first parameter of the functions 'augmentDecl', 'augmentEquation' and
 -- 'augmentLhs' determines whether we have to unrename the function identifiers
@@ -263,11 +264,12 @@
   Equation p <$> augmentLhs mm lhs <*> augment rhs
 
 augmentLhs :: Maybe ModuleIdent -> Lhs PredType -> DTM (Lhs PredType)
-augmentLhs mm lhs@(FunLhs f ts) = do
+augmentLhs mm lhs@(FunLhs spi f ts) = do
     m <- maybe getModuleIdent return mm
     augEnv <- getAugEnv
     if isAugmented augEnv (qualifyWith m $ unRenameIdentIf (isJust mm) f)
-      then return $ FunLhs f $ ConstructorPattern predUnitType qUnitId [] : ts
+      then return $ FunLhs spi f
+                  $ ConstructorPattern NoSpanInfo predUnitType qUnitId [] : ts
       else return lhs
 augmentLhs _ lhs               =
   internalError $ "Dictionary.augmentLhs" ++ show lhs
@@ -278,21 +280,23 @@
     internalError $ "Dictionary.augment: " ++ show rhs
 
 instance Augment Expression where
-  augment l@(Literal     _ _) = return l
-  augment v@(Variable pty v') = do
+  augment l@(Literal     _ _ _) = return l
+  augment v@(Variable _ pty v') = do
     augEnv <- getAugEnv
     return $ if isAugmented augEnv v'
-               then apply (Variable (augmentPredType pty) v')
-                      [Constructor predUnitType qUnitId]
+               then apply (Variable NoSpanInfo (augmentPredType pty) v')
+                      [Constructor NoSpanInfo predUnitType qUnitId]
                else v
-  augment c@(Constructor _ _) = return c
-  augment (Typed       e qty) = flip Typed qty <$> augment e
-  augment (Apply       e1 e2) = Apply <$> augment e1 <*> augment e2
-  augment (Lambda       ts e) = Lambda ts <$> augment e
-  augment (Let          ds e) =
-    Let <$> mapM (augmentDecl Nothing) ds <*> augment e
-  augment (Case      ct e as) = Case ct <$> augment e <*> mapM augment as
-  augment e                   = internalError $ "Dictionary.augment: " ++ show e
+  augment c@(Constructor _ _ _) = return c
+  augment (Typed       spi e qty) = flip (Typed spi) qty <$> augment e
+  augment (Apply       spi e1 e2) = Apply spi <$> augment e1 <*> augment e2
+  augment (Lambda       spi ts e) = Lambda spi ts <$> augment e
+  augment (Let          spi ds e) =
+    Let spi <$> mapM (augmentDecl Nothing) ds <*> augment e
+  augment (Case      spi ct e as) =
+    Case spi ct <$> augment e <*> mapM augment as
+  augment e                     =
+    internalError $ "Dictionary.augment: " ++ show e
 
 instance Augment Alt where
   augment (Alt p t rhs) = Alt p t <$> augment rhs
@@ -304,10 +308,11 @@
 augmentType = TypeArrow unitType
 
 augmentQualTypeExpr :: QualTypeExpr -> QualTypeExpr
-augmentQualTypeExpr (QualTypeExpr cx ty) = QualTypeExpr cx $ augmentTypeExpr ty
+augmentQualTypeExpr (QualTypeExpr spi cx ty) =
+  QualTypeExpr spi cx $ augmentTypeExpr ty
 
 augmentTypeExpr :: TypeExpr -> TypeExpr
-augmentTypeExpr = ArrowType $ ConstructorType qUnitId
+augmentTypeExpr = ArrowType NoSpanInfo $ ConstructorType NoSpanInfo qUnitId
 
 -- -----------------------------------------------------------------------------
 -- Lifting class and instance declarations
@@ -324,7 +329,7 @@
   liftClassDecls (qualifyWith m cls) tv ds
 liftDecls (InstanceDecl _ cx cls ty ds) = do
   clsEnv <- getClassEnv
-  let PredType ps ty' = toPredType [] $ QualTypeExpr cx ty
+  let PredType ps ty' = toPredType [] $ QualTypeExpr NoSpanInfo cx ty
       ps' = minPredSet clsEnv ps
   liftInstanceDecls ps' cls ty' ds
 liftDecls d = return [d]
@@ -364,17 +369,18 @@
 createClassDictDecl :: QualIdent -> Ident -> [Decl a] -> DTM (Decl a)
 createClassDictDecl cls tv ds = do
   c <- createClassDictConstrDecl cls tv ds
-  return $ DataDecl NoPos (dictTypeId cls) [tv] [c] []
+  return $ DataDecl NoSpanInfo (dictTypeId cls) [tv] [c] []
 
 createClassDictConstrDecl :: QualIdent -> Ident -> [Decl a] -> DTM ConstrDecl
 createClassDictConstrDecl cls tv ds = do
   clsEnv <- getClassEnv
   let sclss = superClasses cls clsEnv
-      cx    = [Constraint scls (VariableType tv) | scls <- sclss]
-      tvs   = tv : filter (unRenameIdent tv /=) identSupply
-      mtys  = map (fromType tvs . generalizeMethodType . transformMethodPredType)
-                [toMethodType cls tv qty | TypeSig _ fs qty <- ds, _ <- fs]
-  return $ ConstrDecl NoPos [] cx (dictConstrId cls) mtys
+      cx    = [Constraint NoSpanInfo scls (VariableType NoSpanInfo tv)
+              | scls <- sclss]
+      tvs  = tv : filter (unRenameIdent tv /=) identSupply
+      mtys = map (fromType tvs . generalizeMethodType . transformMethodPredType)
+                 [toMethodType cls tv qty | TypeSig _ fs qty <- ds, _ <- fs]
+  return $ ConstrDecl NoSpanInfo [] cx (dictConstrId cls) mtys
 
 classDictConstrPredType :: ValueEnv -> ClassEnv -> QualIdent -> PredType
 classDictConstrPredType vEnv clsEnv cls = PredType ps $ foldr TypeArrow ty mtys
@@ -388,7 +394,7 @@
 createInstDictDecl :: PredSet -> QualIdent -> Type -> DTM (Decl PredType)
 createInstDictDecl ps cls ty = do
   pty <- PredType ps . arrowBase <$> getInstDictConstrType cls ty
-  funDecl NoPos pty (instFunId cls ty) [] <$> createInstDictExpr cls ty
+  funDecl NoSpanInfo pty (instFunId cls ty) [] <$> createInstDictExpr cls ty
 
 createInstDictExpr :: QualIdent -> Type -> DTM (Expression PredType)
 createInstDictExpr cls ty = do
@@ -396,8 +402,8 @@
   m <- getModuleIdent
   clsEnv <- getClassEnv
   let fs = map (qImplMethodId m cls ty) $ classMethods cls clsEnv
-  return $ apply (Constructor (predType ty') (qDictConstrId cls))
-             (zipWith (Variable . predType) (arrowArgs ty') fs)
+  return $ apply (Constructor NoSpanInfo (predType ty') (qDictConstrId cls))
+             (zipWith (Variable NoSpanInfo . predType) (arrowArgs ty') fs)
 
 getInstDictConstrType :: QualIdent -> Type -> DTM Type
 getInstDictConstrType cls ty = do
@@ -413,10 +419,12 @@
 defaultClassMethodDecl cls f = do
   pty@(PredType _ ty) <- getClassMethodType cls f
   augEnv <- getAugEnv
-  let pats = if isAugmented augEnv (qualifyLike cls f)
-               then [ConstructorPattern predUnitType qUnitId []]
+  let augmented = isAugmented augEnv (qualifyLike cls f)
+      pats = if augmented
+               then [ConstructorPattern NoSpanInfo predUnitType qUnitId []]
                else []
-  return $ funDecl NoPos pty f pats $ preludeError (instType ty) $
+      ty' = if augmented then arrowBase ty else ty
+  return $ funDecl NoSpanInfo pty f pats $ preludeError (instType ty') $
     "No instance or default method for class operation " ++ escName f
 
 getClassMethodType :: QualIdent -> Ident -> DTM PredType
@@ -438,8 +446,8 @@
 defaultInstMethodDecl ps cls ty f = do
   vEnv <- getValueEnv
   let pty@(PredType _ ty') = instMethodType vEnv ps cls ty f
-  return $ funDecl NoPos pty f [] $
-    Variable (predType $ instType ty') (qDefaultMethodId cls f)
+  return $ funDecl NoSpanInfo pty f [] $
+    Variable NoSpanInfo (predType $ instType ty') (qDefaultMethodId cls f)
 
 -- Returns the type for a given instance's method of a given class. To this
 -- end, the class method's type is stripped of its first predicate (which is
@@ -463,7 +471,7 @@
 renameDecl :: Ident -> Decl a -> Decl a
 renameDecl f (FunctionDecl p a _ eqs) = FunctionDecl p a f $ map renameEq eqs
   where renameEq (Equation p' lhs rhs) = Equation p' (renameLhs lhs) rhs
-        renameLhs (FunLhs _ ts) = FunLhs f ts
+        renameLhs (FunLhs _ _ ts) = FunLhs NoSpanInfo f ts
         renameLhs _ = internalError "Dictionary.renameDecl.renameLhs"
 renameDecl _ _ = internalError "Dictionary.renameDecl"
 
@@ -528,12 +536,13 @@
 
 createStubDecl :: Pattern a -> a -> Ident -> (a, Ident) -> [(a, Ident)]
                -> Decl a
-createStubDecl t a f v us = FunctionDecl NoPos a f [createStubEquation t f v us]
+createStubDecl t a f v us =
+  FunctionDecl NoSpanInfo a f [createStubEquation t f v us]
 
 createStubEquation :: Pattern a -> Ident -> (a, Ident) -> [(a, Ident)]
                    -> Equation a
 createStubEquation t f v us =
-  mkEquation NoPos f (t : map (uncurry VariablePattern) us) $
+  mkEquation NoSpanInfo f (t : map (uncurry (VariablePattern NoSpanInfo)) us) $
     apply (uncurry mkVar v) (map (uncurry mkVar) us)
 
 superDictStubType :: QualIdent -> QualIdent -> Type -> Type
@@ -719,15 +728,15 @@
 
 classExports :: ModuleIdent -> ClassEnv -> Ident -> [Export]
 classExports m clsEnv cls =
-  ExportTypeWith (qDictTypeId qcls) [dictConstrId qcls] :
-    map (Export . qSuperDictStubId qcls) (superClasses qcls clsEnv) ++
-      map (Export . qDefaultMethodId qcls) (classMethods qcls clsEnv)
+  ExportTypeWith NoSpanInfo (qDictTypeId qcls) [dictConstrId qcls] :
+   map (Export NoSpanInfo . qSuperDictStubId qcls) (superClasses qcls clsEnv) ++
+    map (Export NoSpanInfo . qDefaultMethodId qcls) (classMethods qcls clsEnv)
   where qcls = qualifyWith m cls
 
 instExports :: ModuleIdent -> ClassEnv -> QualIdent -> Type -> [Export]
 instExports m clsEnv cls ty =
-  Export (qInstFunId m cls ty) :
-    map (Export . qImplMethodId m cls ty) (classMethods cls clsEnv)
+  Export NoSpanInfo (qInstFunId m cls ty) :
+    map (Export NoSpanInfo . qImplMethodId m cls ty) (classMethods cls clsEnv)
 
 -- -----------------------------------------------------------------------------
 -- Transforming the module
@@ -742,7 +751,7 @@
   dictTrans :: a PredType -> DTM (a Type)
 
 instance DictTrans Module where
-  dictTrans (Module ps m es is ds) = do
+  dictTrans (Module spi ps m es is ds) = do
     liftedDs <- concatMapM liftDecls ds
     stubDs <- concatMapM createStubs ds
     tcEnv <- getTyConsEnv
@@ -755,7 +764,7 @@
     modifyValueEnv $ dictTransValues
     modifyTyConsEnv $ dictTransTypes
     dictEs <- addExports es <$> concatMapM dictExports ds
-    return $ Module ps m dictEs is $ transDs ++ stubDs
+    return $ Module spi ps m dictEs is $ transDs ++ stubDs
 
 -- We use and transform the type from the type constructor environment for
 -- transforming a constructor declaration as it contains the reduced and
@@ -780,8 +789,8 @@
   dictTrans (FunctionDecl p      pty f eqs) =
     FunctionDecl p (transformPredType pty) f <$> mapM dictTrans eqs
   dictTrans (PatternDecl           p t rhs) = case t of
-    VariablePattern pty@(PredType ps _) v | not (Set.null ps) ->
-      dictTrans $ FunctionDecl p pty v [Equation p (FunLhs v []) rhs]
+    VariablePattern _ pty@(PredType ps _) v | not (Set.null ps) ->
+      dictTrans $ FunctionDecl p pty v [Equation p (FunLhs NoSpanInfo v []) rhs]
     _ -> withLocalDictEnv $ PatternDecl p <$> dictTrans t <*> dictTrans rhs
   dictTrans d@(FreeDecl                _ _) = return $ fmap unpredType d
   dictTrans d@(ExternalDecl            _ _) = return $ fmap unpredType d
@@ -798,13 +807,13 @@
 dictTransConstrDecl _ d _ = internalError $ "Dictionary.dictTrans: " ++ show d
 
 instance DictTrans Equation where
-  dictTrans (Equation p (FunLhs f ts) rhs) = withLocalValueEnv $ do
+  dictTrans (Equation p (FunLhs _ f ts) rhs) = withLocalValueEnv $ do
     m <- getModuleIdent
     pls <- matchPredList (varType m f) $
              foldr (TypeArrow . typeOf) (typeOf rhs) ts
     ts' <- addDictArgs pls ts
     modifyValueEnv $ bindPatterns ts'
-    Equation p (FunLhs f ts') <$> dictTrans rhs
+    Equation p (FunLhs NoSpanInfo f ts') <$> dictTrans rhs
   dictTrans eq                             =
     internalError $ "Dictionary.dictTrans: " ++ show eq
 
@@ -814,43 +823,45 @@
     internalError $ "Dictionary.dictTrans: " ++ show rhs
 
 instance DictTrans Pattern where
-  dictTrans (LiteralPattern        pty l) =
-    return $ LiteralPattern (unpredType pty) l
-  dictTrans (VariablePattern       pty v) =
-    return $ VariablePattern (unpredType pty) v
-  dictTrans (ConstructorPattern pty c ts) = do
+  dictTrans (LiteralPattern        _ pty l) =
+    return $ LiteralPattern NoSpanInfo (unpredType pty) l
+  dictTrans (VariablePattern       _ pty v) =
+    return $ VariablePattern NoSpanInfo (unpredType pty) v
+  dictTrans (ConstructorPattern _ pty c ts) = do
     pls <- matchPredList (conType c) $
              foldr (TypeArrow . typeOf) (unpredType pty) ts
-    ConstructorPattern (unpredType pty) c <$> addDictArgs pls ts
-  dictTrans (AsPattern               v t) = AsPattern v <$> dictTrans t
-  dictTrans t                             =
+    ConstructorPattern NoSpanInfo (unpredType pty) c <$> addDictArgs pls ts
+  dictTrans (AsPattern               _ v t) =
+    AsPattern NoSpanInfo v <$> dictTrans t
+  dictTrans t                               =
     internalError $ "Dictionary.dictTrans: " ++ show t
 
 instance DictTrans Expression where
-  dictTrans (Literal     pty l) = return $ Literal (unpredType pty) l
-  dictTrans (Variable    pty v) = do
+  dictTrans (Literal     _ pty l) =
+    return $ Literal NoSpanInfo (unpredType pty) l
+  dictTrans (Variable    _ pty v) = do
     pls <- matchPredList (funType v) (unpredType pty)
     es <- mapM dictArg pls
     let ty = foldr (TypeArrow . typeOf) (unpredType pty) es
-    return $ apply (Variable ty v) es
-  dictTrans (Constructor pty c) = do
+    return $ apply (Variable NoSpanInfo ty v) es
+  dictTrans (Constructor _ pty c) = do
     pls <- matchPredList (conType c) (unpredType pty)
     es <- mapM dictArg pls
     let ty = foldr (TypeArrow . typeOf) (unpredType pty) es
-    return $ apply (Constructor ty c) es
-  dictTrans (Apply       e1 e2) =
-    Apply <$> dictTrans e1 <*> dictTrans e2
-  dictTrans (Typed       e qty) =
-    Typed <$> dictTrans e <*> dictTransQualTypeExpr qty
-  dictTrans (Lambda       ts e) = withLocalValueEnv $ withLocalDictEnv $ do
+    return $ apply (Constructor NoSpanInfo ty c) es
+  dictTrans (Apply       _ e1 e2) =
+    Apply NoSpanInfo <$> dictTrans e1 <*> dictTrans e2
+  dictTrans (Typed       _ e qty) =
+    Typed NoSpanInfo <$> dictTrans e <*> dictTransQualTypeExpr qty
+  dictTrans (Lambda       _ ts e) = withLocalValueEnv $ withLocalDictEnv $ do
     ts' <- mapM dictTrans ts
     modifyValueEnv $ bindPatterns ts'
-    Lambda ts' <$> dictTrans e
-  dictTrans (Let          ds e) = withLocalValueEnv $ do
+    Lambda NoSpanInfo ts' <$> dictTrans e
+  dictTrans (Let          _ ds e) = withLocalValueEnv $ do
     modifyValueEnv $ bindDecls ds
-    Let <$> mapM dictTrans ds <*> dictTrans e
-  dictTrans (Case      ct e as) =
-    Case ct <$> dictTrans e <*> mapM dictTrans as
+    Let NoSpanInfo <$> mapM dictTrans ds <*> dictTrans e
+  dictTrans (Case      _ ct e as) =
+    Case NoSpanInfo ct <$> dictTrans e <*> mapM dictTrans as
   dictTrans e                   =
     internalError $ "Dictionary.dictTrans: " ++ show e
 
@@ -860,7 +871,7 @@
 -- TODO: Verify
 
 dictTransQualTypeExpr :: QualTypeExpr -> DTM QualTypeExpr
-dictTransQualTypeExpr (QualTypeExpr _ ty) = return $ QualTypeExpr [] ty
+dictTransQualTypeExpr (QualTypeExpr spi _ ty) = return $ QualTypeExpr spi [] ty
 
 instance DictTrans Alt where
   dictTrans (Alt p t rhs) = withLocalValueEnv $ withLocalDictEnv $ do
@@ -873,16 +884,18 @@
   dictVars <- mapM (freshVar "_#dict" . dictType) pls
   clsEnv <- getClassEnv
   modifyDictEnv $ (++) $ dicts clsEnv $ zip pls (map (uncurry mkVar) dictVars)
-  (++) (map (uncurry VariablePattern) dictVars) <$> mapM dictTrans ts
+  (++) (map (uncurry (VariablePattern NoSpanInfo )) dictVars)
+         <$> mapM dictTrans ts
   where dicts clsEnv vs
           | null vs = vs
           | otherwise = vs ++ dicts clsEnv (concatMap (superDicts clsEnv) vs)
         superDicts clsEnv (Pred cls ty, e) =
           map (superDict cls ty e) (superClasses cls clsEnv)
         superDict cls ty e scls =
-          (Pred scls ty, Apply (superDictExpr cls scls ty) e)
+          (Pred scls ty, Apply NoSpanInfo (superDictExpr cls scls ty) e)
         superDictExpr cls scls ty =
-          Variable (superDictStubType cls scls ty) (qSuperDictStubId cls scls)
+          Variable NoSpanInfo (superDictStubType cls scls ty)
+            (qSuperDictStubId cls scls)
 
 -- The function 'dictArg' constructs the dictionary argument for a predicate
 -- from the predicates of a class method or an overloaded function. It checks
@@ -901,7 +914,8 @@
 instDict p = instPredList p >>= flip (uncurry instFunApp) p
 
 instFunApp :: ModuleIdent -> [Pred] -> Pred -> DTM (Expression Type)
-instFunApp m pls p@(Pred cls ty) = apply (Variable ty' f) <$> mapM dictArg pls
+instFunApp m pls p@(Pred cls ty) = apply (Variable NoSpanInfo ty' f)
+  <$> mapM dictArg pls
   where f   = qInstFunId m cls ty
         ty' = foldr1 TypeArrow $ map dictType $ pls ++ [p]
 
@@ -978,11 +992,11 @@
   specialize :: a Type -> DTM (a Type)
 
 instance Specialize Module where
-  specialize (Module ps m es is ds) = do
+  specialize (Module spi ps m es is ds) = do
     clsEnv <- getClassEnv
     inEnv <- getInstEnv
     setSpEnv $ initSpEnv clsEnv inEnv
-    Module ps m es is <$> mapM specialize ds
+    Module spi ps m es is <$> mapM specialize ds
 
 instance Specialize Decl where
   specialize (FunctionDecl p ty f eqs) =
@@ -1002,33 +1016,33 @@
   specialize e = specialize' e []
 
 specialize' :: Expression Type -> [Expression Type] -> DTM (Expression Type)
-specialize' l@(Literal     _ _) es = return $ apply l es
-specialize' v@(Variable   _ v') es = do
+specialize' l@(Literal     _ _ _) es = return $ apply l es
+specialize' v@(Variable   _ _ v') es = do
   spEnv <- getSpEnv
   return $ case Map.lookup (v', f) spEnv of
-    Just f' -> apply (Variable ty' f') $ es'' ++ es'
+    Just f' -> apply (Variable NoSpanInfo ty' f') $ es'' ++ es'
     Nothing -> apply v es
   where d:es' = es
-        (Variable _ f, es'') = unapply d []
-        ty' = foldr (TypeArrow . typeOf) (typeOf $ Apply v d) es''
-specialize' c@(Constructor _ _) es = return $ apply c es
-specialize' (Typed       e qty) es = do
+        (Variable _ _ f, es'') = unapply d []
+        ty' = foldr (TypeArrow . typeOf) (typeOf $ Apply NoSpanInfo v d) es''
+specialize' c@(Constructor _ _ _) es = return $ apply c es
+specialize' (Typed       _ e qty) es = do
   e' <- specialize e
-  return $ apply (Typed e' qty) es
-specialize' (Apply       e1 e2) es = do
+  return $ apply (Typed NoSpanInfo e' qty) es
+specialize' (Apply       _ e1 e2) es = do
   e2' <- specialize e2
   specialize' e1 $ e2' : es
-specialize' (Lambda       ts e) es = do
+specialize' (Lambda       _ ts e) es = do
   e' <- specialize e
-  return $ apply (Lambda ts e') es
-specialize' (Let          ds e) es = do
+  return $ apply (Lambda NoSpanInfo ts e') es
+specialize' (Let          _ ds e) es = do
   ds' <- mapM specialize ds
   e' <- specialize e
-  return $ apply (Let ds' e') es
-specialize' (Case      ct e as) es = do
+  return $ apply (Let NoSpanInfo ds' e') es
+specialize' (Case      _ ct e as) es = do
   e' <- specialize e
   as' <- mapM specialize as
-  return $ apply (Case ct e' as') es
+  return $ apply (Case NoSpanInfo ct e' as') es
 specialize' e                   _  =
   internalError $ "Dictionary.specialize': " ++ show e
 
@@ -1047,22 +1061,22 @@
 -- transformation.
 
 cleanup :: Module a -> DTM (Module a)
-cleanup (Module ps m es is ds) = do
+cleanup (Module spi ps m es is ds) = do
   cleanedEs <- traverse cleanupExportSpec es
   cleanedDs <- concatMapM cleanupInfixDecl ds
   cleanupTyConsEnv
   cleanupPrecEnv
-  return $ Module ps m cleanedEs is cleanedDs
+  return $ Module spi ps m cleanedEs is cleanedDs
 
 cleanupExportSpec :: ExportSpec -> DTM ExportSpec
 cleanupExportSpec (Exporting p es) = Exporting p <$> concatMapM cleanupExport es
 
 cleanupExport :: Export -> DTM [Export]
-cleanupExport e@(Export             _) = return [e]
-cleanupExport e@(ExportTypeWith tc cs) = do
+cleanupExport e@(Export             _ _) = return [e]
+cleanupExport e@(ExportTypeWith spi tc cs) = do
   tcEnv <- getTyConsEnv
   case qualLookupTypeInfo tc tcEnv of
-    [TypeClass _ _ _] -> return $ map (Export . qualifyLike tc) cs
+    [TypeClass _ _ _] -> return $ map (Export spi . qualifyLike tc) cs
     _                 -> return [e]
 cleanupExport e                        =
   internalError $ "Dictionary.cleanupExport: " ++ show e
@@ -1153,7 +1167,7 @@
 dictTransIConstrDecl m tvs (RecordDecl      p evs cx c fs) =
   RecordDecl p evs [] c $
     map toFieldDecl (transformIContext m (tvs ++ evs) cx) ++ fs
-  where toFieldDecl = FieldDecl NoPos [anonId]
+  where toFieldDecl = FieldDecl NoSpanInfo [anonId]
 
 transformIContext :: ModuleIdent -> [Ident] -> Context -> [TypeExpr]
 transformIContext m tvs cx =
@@ -1170,7 +1184,7 @@
                                -> ConstrDecl
 iConstrDeclFromDataConstructor m vEnv c = case qualLookupValue c vEnv of
   [DataConstructor _ _ _ (ForAllExist n n' pty)] ->
-    ConstrDecl NoPos evs [] (unqualify c) tys
+    ConstrDecl NoSpanInfo evs [] (unqualify c) tys
     where evs = take n' $ drop n identSupply
           tys = map (fromQualType m identSupply) $ arrowArgs $ unpredType pty
   _ -> internalError $ "Dictionary.iConstrDeclFromDataConstructor: " ++ show c
@@ -1281,13 +1295,16 @@
 
 preludeError :: Type -> String -> Expression PredType
 preludeError a =
-  Apply (Variable (predType (TypeArrow stringType a)) qErrorId) . stringExpr
+  Apply NoSpanInfo (Variable NoSpanInfo
+                     (predType (TypeArrow stringType a)) qErrorId) . stringExpr
 
 stringExpr :: String -> Expression PredType
-stringExpr = foldr (consExpr . Literal (predType charType) . Char) nilExpr
+stringExpr = foldr (consExpr . Literal NoSpanInfo (predType charType) . Char)
+               nilExpr
   where
-  nilExpr = Constructor (predType stringType) qNilId
-  consExpr = Apply . Apply (Constructor (predType $ consType charType) qConsId)
+  nilExpr = Constructor NoSpanInfo (predType stringType) qNilId
+  consExpr = (Apply NoSpanInfo) . (Apply NoSpanInfo)
+    (Constructor NoSpanInfo (predType $ consType charType) qConsId)
 
 -- The function 'varType' is able to lookup both local and global identifiers.
 -- Since the environments have been qualified before, global declarations are
diff --git a/src/Transformations/Lift.hs b/src/Transformations/Lift.hs
--- a/src/Transformations/Lift.hs
+++ b/src/Transformations/Lift.hs
@@ -28,9 +28,11 @@
 import qualified Control.Monad.State as S   (State, runState, gets, modify)
 import           Data.List
 import qualified Data.Map            as Map (Map, empty, insert, lookup)
-import           Data.Maybe                 (catMaybes, fromJust)
+import           Data.Maybe                 (mapMaybe, fromJust)
 import qualified Data.Set            as Set (fromList, toList, unions)
+
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.AnnotExpr
@@ -45,11 +47,11 @@
 import Env.Value
 
 lift :: ValueEnv -> Module Type -> (Module Type, ValueEnv)
-lift vEnv (Module ps m es is ds) = (lifted, valueEnv s')
+lift vEnv (Module spi ps m es is ds) = (lifted, valueEnv s')
   where
   (ds', s') = S.runState (mapM (absDecl "" []) ds) initState
   initState = LiftState m vEnv Map.empty
-  lifted    = Module ps m es is $ concatMap liftFunDecl ds'
+  lifted    = Module spi ps m es is $ concatMap liftFunDecl ds'
 
 -- -----------------------------------------------------------------------------
 -- Abstraction
@@ -105,7 +107,7 @@
 absDecl _   _   d                         = return d
 
 absEquation :: [Ident] -> Equation Type -> LiftM (Equation Type)
-absEquation lvs (Equation p lhs@(FunLhs f ts) rhs) =
+absEquation lvs (Equation p lhs@(FunLhs _ f ts) rhs) =
   Equation p lhs <$> absRhs (idName f ++ ".") lvs' rhs
   where lvs' = lvs ++ bv ts
 absEquation _ _ = error "Lift.absEquation: no pattern match"
@@ -176,7 +178,7 @@
 absFunDecls pre lvs []         vds e = do
   vds' <- mapM (absDecl pre lvs) vds
   e' <- absExpr pre lvs e
-  return (Let vds' e')
+  return (Let NoSpanInfo vds' e')
 absFunDecls pre lvs (fds:fdss) vds e = do
   m <- getModuleIdent
   env <- getAbstractEnv
@@ -185,9 +187,9 @@
       fs      = bv fds
       -- function types
       ftys    = map extractFty fds
-      extractFty (FunctionDecl _ _ f ((Equation _ (FunLhs _ ts) rhs):_)) =
+      extractFty (FunctionDecl _ _ f (Equation _ (FunLhs _ _ ts) rhs : _)) =
         (f, foldr TypeArrow (typeOf rhs) $ map typeOf ts)
-      extractFty _                                                       =
+      extractFty _                                                         =
         internalError "Lift.absFunDecls.extractFty"
       -- typed free variables on the right-hand sides
       fvsRhs  = Set.unions
@@ -234,7 +236,7 @@
     fds' <- mapM (absFunDecl pre fvs lvs) [d | d <- fds, any (`elem` fs') (bv d)]
     -- abstract remaining declarations
     e'   <- absFunDecls pre lvs fdss vds e
-    return (Let fds' e')
+    return (Let NoSpanInfo fds' e')
 
 -- When the free variables of a function are abstracted, the type of the
 -- function must be changed as well.
@@ -249,14 +251,15 @@
   return $ FunctionDecl p ty'' f' eqs''
   where f' = liftIdent pre f
         ty' = foldr TypeArrow (typeOf rhs') (map typeOf ts')
-          where Equation _ (FunLhs _ ts') rhs' = head eqs'
+          where Equation _ (FunLhs _ _ ts') rhs' = head eqs'
         ty'' = genType ty'
         eqs' = map addVars eqs
         genType ty''' = subst (foldr2 bindSubst idSubst tvs tvs') ty'''
           where tvs = nub (typeVars ty''')
                 tvs' = map TypeVariable [0 ..]
-        addVars (Equation p' (FunLhs _ ts) rhs) =
-          Equation p' (FunLhs f' (map (uncurry VariablePattern) fvs ++ ts)) rhs
+        addVars (Equation p' (FunLhs _ _ ts) rhs) =
+          Equation p' (FunLhs NoSpanInfo
+            f' (map (uncurry (VariablePattern NoSpanInfo)) fvs ++ ts)) rhs
         addVars _ = error "Lift.absFunDecl.addVars: no pattern match"
 absFunDecl pre _ _ (ExternalDecl p vs) = ExternalDecl p <$> mapM (absVar pre) vs
 absFunDecl _ _ _ _ = error "Lift.absFunDecl: no pattern match"
@@ -270,8 +273,8 @@
   where f' = liftIdent pre f
 
 absExpr :: String -> [Ident] -> Expression Type -> LiftM (Expression Type)
-absExpr _   _   l@(Literal     _ _) = return l
-absExpr pre lvs var@(Variable ty v)
+absExpr _   _   l@(Literal     _ _ _) = return l
+absExpr pre lvs var@(Variable _ ty v)
   | isQualified v = return var
   | otherwise     = do
     getAbstractEnv >>= \env -> case Map.lookup (unqualify v) env of
@@ -285,17 +288,18 @@
         -- !!! to obtain a type substitution that can then be applied to  !!!
         -- !!! the type annotations in the replacement expression.        !!!
         -- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        absType ty' (Variable _ v') = Variable ty' v'
-        absType ty' (Apply   e1 e2) =
-          Apply (absType (TypeArrow (typeOf e2) ty') e1) e2
+        absType ty' (Variable spi _ v') = Variable spi ty' v'
+        absType ty' (Apply   spi e1 e2) =
+          Apply spi (absType (TypeArrow (typeOf e2) ty') e1) e2
         absType _ _ = internalError "Lift.absExpr.absType"
-absExpr _   _   c@(Constructor _ _) = return c
-absExpr pre lvs (Apply       e1 e2) = Apply         <$> absExpr pre lvs e1
+absExpr _   _   c@(Constructor _ _ _) = return c
+absExpr pre lvs (Apply       spi e1 e2) = Apply spi <$> absExpr pre lvs e1
                                                     <*> absExpr pre lvs e2
-absExpr pre lvs (Let          ds e) = absDeclGroup pre lvs ds e
-absExpr pre lvs (Case      ct e bs) = Case ct       <$> absExpr pre lvs e
-                                                    <*> mapM (absAlt pre lvs) bs
-absExpr pre lvs (Typed        e ty) = flip Typed ty <$> absExpr pre lvs e
+absExpr pre lvs (Let            _ ds e) = absDeclGroup pre lvs ds e
+absExpr pre lvs (Case      spi ct e bs) =
+  Case spi ct <$> absExpr pre lvs e <*> mapM (absAlt pre lvs) bs
+absExpr pre lvs (Typed        spi e ty) =
+  flip (Typed spi) ty <$> absExpr pre lvs e
 absExpr _   _   e                   = internalError $ "Lift.absExpr: " ++ show e
 
 absAlt :: String -> [Ident] -> Alt Type -> LiftM (Alt Type)
@@ -335,19 +339,20 @@
         (vds', dss') = unzip $ map liftVarDecl vds
 
 liftExpr :: Eq a => Expression a -> (Expression a, [Decl a])
-liftExpr l@(Literal     _ _) = (l, [])
-liftExpr v@(Variable    _ _) = (v, [])
-liftExpr c@(Constructor _ _) = (c, [])
-liftExpr (Apply       e1 e2) = (Apply e1' e2', ds1 ++ ds2)
+liftExpr l@(Literal     _ _ _) = (l, [])
+liftExpr v@(Variable    _ _ _) = (v, [])
+liftExpr c@(Constructor _ _ _) = (c, [])
+liftExpr (Apply       spi e1 e2) = (Apply spi e1' e2', ds1 ++ ds2)
   where (e1', ds1) = liftExpr e1
         (e2', ds2) = liftExpr e2
-liftExpr (Let          ds e) = (mkLet ds' e', ds1 ++ ds2)
+liftExpr (Let          _ ds e) = (mkLet ds' e', ds1 ++ ds2)
   where (ds', ds1) = liftDeclGroup ds
         (e' , ds2) = liftExpr e
-liftExpr (Case    ct e alts) = (Case ct e' alts', concat $ ds' : dss')
+liftExpr (Case    spi ct e alts) = (Case spi ct e' alts', concat $ ds' : dss')
   where (e'   , ds' ) = liftExpr e
         (alts', dss') = unzip $ map liftAlt alts
-liftExpr (Typed        e ty) = (Typed e' ty, ds) where (e', ds) = liftExpr e
+liftExpr (Typed        spi e ty) =
+  (Typed spi e' ty, ds) where (e', ds) = liftExpr e
 liftExpr _ = internalError "Lift.liftExpr"
 
 liftAlt :: Eq a => Alt a -> (Alt a, [Decl a])
@@ -374,16 +379,16 @@
   where (rm, lhs') = renameLhs lhs
 
 renameLhs :: Eq a => Lhs a -> (RenameMap a, Lhs a)
-renameLhs (FunLhs f ts) = (rm, FunLhs f ts')
+renameLhs (FunLhs spi f ts) = (rm, FunLhs spi f ts')
   where (rm, ts') = foldr renamePattern ([], []) ts
 renameLhs _             = error "Lift.renameLhs"
 
 renamePattern :: Eq a => Pattern a -> (RenameMap a, [Pattern a])
               -> (RenameMap a, [Pattern a])
-renamePattern (VariablePattern a v) (rm, ts)
+renamePattern (VariablePattern spi a v) (rm, ts)
   | v `elem` varPatNames ts =
     let v' = updIdentName (++ ("." ++ show (length rm))) v
-    in  (((a, v), v') : rm, VariablePattern a v' : ts)
+    in  (((a, v), v') : rm, VariablePattern spi a v' : ts)
 renamePattern t                     (rm, ts) = (rm, t : ts)
 
 renameRhs :: Eq a => RenameMap a -> Rhs a -> Rhs a
@@ -391,19 +396,20 @@
 renameRhs _  _                 = error "Lift.renameRhs"
 
 renameExpr :: Eq a => RenameMap a -> Expression a -> Expression a
-renameExpr _  l@(Literal     _ _) = l
-renameExpr rm v@(Variable   a v')
+renameExpr _  l@(Literal       _ _ _) = l
+renameExpr rm v@(Variable   spi a v')
   | isQualified v' = v
   | otherwise      = case lookup (a, unqualify v') rm of
-                       Just v'' -> Variable a (qualify v'')
+                       Just v'' -> Variable spi a (qualify v'')
                        _        -> v
-renameExpr _  c@(Constructor _ _) = c
-renameExpr rm (Typed        e ty) = Typed (renameExpr rm e) ty
-renameExpr rm (Apply       e1 e2) = Apply (renameExpr rm e1) (renameExpr rm e2)
-renameExpr rm (Let          ds e) =
-  Let (map (renameDecl rm) ds) (renameExpr rm e)
-renameExpr rm (Case    ct e alts) =
-  Case ct (renameExpr rm e) (map (renameAlt rm) alts)
+renameExpr _  c@(Constructor _ _ _) = c
+renameExpr rm (Typed       spi e ty) = Typed spi (renameExpr rm e) ty
+renameExpr rm (Apply       spi e1 e2) =
+  Apply spi (renameExpr rm e1) (renameExpr rm e2)
+renameExpr rm (Let         spi ds e) =
+  Let spi (map (renameDecl rm) ds) (renameExpr rm e)
+renameExpr rm (Case    spi ct e alts) =
+  Case spi ct (renameExpr rm e) (map (renameAlt rm) alts)
 renameExpr _  _                   = error "Lift.renameExpr"
 
 renameDecl :: Eq a => RenameMap a -> Decl a -> Decl a
@@ -423,16 +429,16 @@
 isFunDecl _                      = False
 
 mkFun :: ModuleIdent -> String -> a -> Ident -> Expression a
-mkFun m pre a = Variable a . qualifyWith m . liftIdent pre
+mkFun m pre a = Variable NoSpanInfo a . qualifyWith m . liftIdent pre
 
 liftIdent :: String -> Ident -> Ident
 liftIdent prefix x = renameIdent (mkIdent $ prefix ++ showIdent x) $ idUnique x
 
 varPatNames :: [Pattern a] -> [Ident]
-varPatNames = catMaybes . map varPatName
+varPatNames = mapMaybe varPatName
 
 varPatName :: Pattern a -> Maybe Ident
-varPatName (VariablePattern _ i) = Just i
+varPatName (VariablePattern _ _ i) = Just i
 varPatName _                     = Nothing
 
 dummyType :: Type
diff --git a/src/Transformations/Newtypes.hs b/src/Transformations/Newtypes.hs
--- a/src/Transformations/Newtypes.hs
+++ b/src/Transformations/Newtypes.hs
@@ -42,7 +42,7 @@
   nt = mapM nt
 
 instance Show a => Newtypes (Module a) where
-  nt (Module ps m es is ds) = Module ps m es is <$> mapM nt ds
+  nt (Module spi ps m es is ds) = Module spi ps m es is <$> mapM nt ds
 
 instance Show a => Newtypes (Decl a) where
   nt d@(InfixDecl       _ _ _ _) = return d
@@ -61,7 +61,7 @@
   nt (Equation p lhs rhs) = Equation p <$> nt lhs <*> nt rhs
 
 instance Show a => Newtypes (Lhs a) where
-  nt (FunLhs f ts) = FunLhs f <$> nt ts
+  nt (FunLhs spi f ts) = FunLhs spi f <$> nt ts
   nt lhs           = internalError $
     "Newtypes.Newtypes.nt: unexpected left-hand-side: " ++ show lhs
 
@@ -71,32 +71,32 @@
     "Newtypes.Newtypes.nt: unexpected right-hand-side: " ++ show rhs
 
 instance Show a => Newtypes (Pattern a) where
-  nt t@(LiteralPattern      _ _) = return t
-  nt t@(VariablePattern     _ _) = return t
-  nt (ConstructorPattern a c ts) = case ts of
+  nt t@(LiteralPattern        _ _ _) = return t
+  nt t@(VariablePattern       _ _ _) = return t
+  nt (ConstructorPattern spi a c ts) = case ts of
     [t] -> do
       isNc <- isNewtypeConstr c
       if isNc then nt t
-              else ConstructorPattern a c <$> ((: []) <$> nt t)
-    _   -> ConstructorPattern a c <$> mapM nt ts
-  nt (AsPattern             v t) = AsPattern v <$> nt t
-  nt t                      = internalError $
+              else ConstructorPattern spi a c <$> ((: []) <$> nt t)
+    _   -> ConstructorPattern spi a c <$> mapM nt ts
+  nt (AsPattern             spi v t) = AsPattern spi v <$> nt t
+  nt t                               = internalError $
     "Newtypes.Newtypes.nt: unexpected pattern: " ++ show t
 
 instance Show a => Newtypes (Expression a) where
-  nt e@(Literal   _ _) = return e
-  nt e@(Variable  _ _) = return e
-  nt (Constructor a c) = do
+  nt e@(Literal   _   _ _) = return e
+  nt e@(Variable    _ _ _) = return e
+  nt (Constructor spi a c) = do
     isNc <- isNewtypeConstr c
-    return $ if isNc then Variable a qIdId else Constructor a c
-  nt (Apply     e1 e2) = case e1 of
-    Constructor _ c -> do
+    return $ if isNc then Variable spi a qIdId else Constructor spi a c
+  nt (Apply     spi e1 e2) = case e1 of
+    Constructor _ _ c -> do
       isNc <- isNewtypeConstr c
-      if isNc then nt e2 else Apply <$> nt e1 <*> nt e2
-    _ -> Apply <$> nt e1 <*> nt e2
-  nt (Case    ct e as) = Case ct <$> nt e <*> mapM nt as
-  nt (Let        ds e) = Let <$> nt ds <*> nt e
-  nt (Typed     e qty) = flip Typed qty <$> nt e
+      if isNc then nt e2 else Apply spi <$> nt e1 <*> nt e2
+    _ -> Apply spi <$> nt e1 <*> nt e2
+  nt (Case    spi ct e as) = Case spi ct <$> nt e <*> mapM nt as
+  nt (Let        spi ds e) = Let spi <$> nt ds <*> nt e
+  nt (Typed     spi e qty) = flip (Typed spi) qty <$> nt e
   nt e                 = internalError $
     "Newtypes.Newtypes.nt: unexpected expression: " ++ show e
 
diff --git a/src/Transformations/Qual.hs b/src/Transformations/Qual.hs
--- a/src/Transformations/Qual.hs
+++ b/src/Transformations/Qual.hs
@@ -51,20 +51,20 @@
 qual m tcEnv tyEnv mdl = R.runReader (qModule mdl) (QualEnv m tcEnv tyEnv)
 
 qModule :: Qual (Module a)
-qModule (Module ps m es is ds) = do
+qModule (Module spi ps m es is ds) = do
   es' <- qExportSpec es
   ds' <- mapM qDecl  ds
-  return (Module ps m es' is ds')
+  return (Module spi ps m es' is ds')
 
 qExportSpec :: Qual (Maybe ExportSpec)
 qExportSpec Nothing                 = return Nothing
 qExportSpec (Just (Exporting p es)) = (Just . Exporting p) <$> mapM qExport es
 
 qExport :: Qual Export
-qExport (Export            x) = Export <$> qIdent x
-qExport (ExportTypeWith t cs) = flip ExportTypeWith cs <$> qConstr t
-qExport (ExportTypeAll     t) = ExportTypeAll <$> qConstr t
-qExport m@(ExportModule    _) = return m
+qExport (Export            spi x) = Export spi <$> qIdent x
+qExport (ExportTypeWith spi t cs) = flip (ExportTypeWith spi) cs <$> qConstr t
+qExport (ExportTypeAll     spi t) = ExportTypeAll spi <$> qConstr t
+qExport m@(ExportModule      _ _) = return m
 
 qDecl :: Qual (Decl a)
 qDecl i@(InfixDecl          _ _ _ _) = return i
@@ -103,100 +103,112 @@
 qFieldDecl (FieldDecl p fs ty) = FieldDecl p fs <$> qTypeExpr ty
 
 qConstraint :: Qual Constraint
-qConstraint (Constraint cls ty) = Constraint <$> qClass cls <*> qTypeExpr ty
+qConstraint (Constraint spi cls ty) =
+  Constraint spi <$> qClass cls <*> qTypeExpr ty
 
 qContext :: Qual Context
 qContext = mapM qConstraint
 
 qTypeExpr :: Qual TypeExpr
-qTypeExpr (ConstructorType     c) = ConstructorType <$> qConstr c
-qTypeExpr (ApplyType     ty1 ty2) = ApplyType <$> qTypeExpr ty1
+qTypeExpr (ConstructorType     spi c) = ConstructorType spi <$> qConstr c
+qTypeExpr (ApplyType     spi ty1 ty2) = ApplyType spi <$> qTypeExpr ty1
                                               <*> qTypeExpr ty2
-qTypeExpr v@(VariableType      _) = return v
-qTypeExpr (TupleType         tys) = TupleType <$> mapM qTypeExpr tys
-qTypeExpr (ListType           ty) = ListType  <$> qTypeExpr ty
-qTypeExpr (ArrowType     ty1 ty2) = ArrowType <$> qTypeExpr ty1
+qTypeExpr v@(VariableType        _ _) = return v
+qTypeExpr (TupleType         spi tys) = TupleType spi <$> mapM qTypeExpr tys
+qTypeExpr (ListType           spi ty) = ListType spi  <$> qTypeExpr ty
+qTypeExpr (ArrowType     spi ty1 ty2) = ArrowType spi <$> qTypeExpr ty1
                                               <*> qTypeExpr ty2
-qTypeExpr (ParenType          ty) = ParenType <$> qTypeExpr ty
-qTypeExpr (ForallType      vs ty) = ForallType vs <$> qTypeExpr ty
+qTypeExpr (ParenType          spi ty) = ParenType spi <$> qTypeExpr ty
+qTypeExpr (ForallType      spi vs ty) = ForallType spi vs <$> qTypeExpr ty
 
 qQualTypeExpr :: Qual QualTypeExpr
-qQualTypeExpr (QualTypeExpr cx ty) = QualTypeExpr <$> qContext cx
-                                                  <*> qTypeExpr ty
+qQualTypeExpr (QualTypeExpr spi cx ty) = QualTypeExpr spi <$> qContext cx
+                                                          <*> qTypeExpr ty
 
 qEquation :: Qual (Equation a)
 qEquation (Equation p lhs rhs) = Equation p <$> qLhs lhs <*> qRhs rhs
 
 qLhs :: Qual (Lhs a)
-qLhs (FunLhs    f ts) = FunLhs f      <$> mapM qPattern ts
-qLhs (OpLhs t1 op t2) = flip OpLhs op <$> qPattern t1 <*> qPattern t2
-qLhs (ApLhs   lhs ts) = ApLhs         <$> qLhs lhs <*> mapM qPattern ts
+qLhs (FunLhs sp    f ts) = FunLhs sp       f  <$> mapM qPattern ts
+qLhs (OpLhs sp t1 op t2) = flip (OpLhs sp) op <$> qPattern t1 <*> qPattern t2
+qLhs (ApLhs sp   lhs ts) = ApLhs sp           <$> qLhs lhs <*> mapM qPattern ts
 
 qPattern :: Qual (Pattern a)
-qPattern l@(LiteralPattern        _ _) = return l
-qPattern n@(NegativePattern       _ _) = return n
-qPattern v@(VariablePattern       _ _) = return v
-qPattern (ConstructorPattern   a c ts) = ConstructorPattern a
-                                         <$> qIdent c <*> mapM qPattern ts
-qPattern (InfixPattern     a t1 op t2) = InfixPattern a <$> qPattern t1
-                                                        <*> qIdent op
-                                                        <*> qPattern t2
-qPattern (ParenPattern              t) = ParenPattern <$> qPattern t
-qPattern (RecordPattern        a c fs) = RecordPattern a <$> qIdent c
-                                         <*> mapM (qField qPattern) fs
-qPattern (TuplePattern             ts) = TuplePattern <$> mapM qPattern ts
-qPattern (ListPattern            a ts) = ListPattern a <$> mapM qPattern ts
-qPattern (AsPattern               v t) = AsPattern v <$> qPattern t
-qPattern (LazyPattern               t) = LazyPattern <$> qPattern t
-qPattern (FunctionPattern      a f ts) = FunctionPattern a <$> qIdent f
-                                                           <*> mapM qPattern ts
-qPattern (InfixFuncPattern a t1 op t2) = InfixFuncPattern a <$> qPattern t1
-                                                            <*> qIdent op
-                                                            <*> qPattern t2
+qPattern l@(LiteralPattern          _ _ _) = return l
+qPattern n@(NegativePattern         _ _ _) = return n
+qPattern v@(VariablePattern         _ _ _) = return v
+qPattern (ConstructorPattern   spi a c ts) =
+  ConstructorPattern spi a <$> qIdent c <*> mapM qPattern ts
+qPattern (InfixPattern     spi a t1 op t2) =
+  InfixPattern spi a <$> qPattern t1 <*> qIdent op <*> qPattern t2
+qPattern (ParenPattern              spi t) = ParenPattern spi <$> qPattern t
+qPattern (RecordPattern        spi a c fs) = RecordPattern spi a <$> qIdent c
+                                          <*> mapM (qField qPattern) fs
+qPattern (TuplePattern             spi ts) =
+  TuplePattern spi <$> mapM qPattern ts
+qPattern (ListPattern            spi a ts) =
+  ListPattern spi a <$> mapM qPattern ts
+qPattern (AsPattern               spi v t) = AsPattern spi v <$> qPattern t
+qPattern (LazyPattern               spi t) = LazyPattern spi <$> qPattern t
+qPattern (FunctionPattern      spi a f ts) =
+  FunctionPattern spi a <$> qIdent f <*> mapM qPattern ts
+qPattern (InfixFuncPattern spi a t1 op t2) =
+  InfixFuncPattern spi a <$> qPattern t1 <*> qIdent op <*> qPattern t2
 
 qRhs :: Qual (Rhs a)
-qRhs (SimpleRhs p e ds) = SimpleRhs p <$> qExpr e           <*> mapM qDecl ds
-qRhs (GuardedRhs es ds) = GuardedRhs  <$> mapM qCondExpr es <*> mapM qDecl ds
+qRhs (SimpleRhs spi e ds) =
+  SimpleRhs  spi <$> qExpr e           <*> mapM qDecl ds
+qRhs (GuardedRhs spi es ds) =
+  GuardedRhs spi <$> mapM qCondExpr es <*> mapM qDecl ds
 
 qCondExpr :: Qual (CondExpr a)
 qCondExpr (CondExpr p g e) = CondExpr p <$> qExpr g <*> qExpr e
 
 qExpr :: Qual (Expression a)
-qExpr l@(Literal           _ _) = return l
-qExpr (Variable            a v) = Variable     a <$> qIdent v
-qExpr (Constructor         a c) = Constructor  a <$> qIdent c
-qExpr (Paren                 e) = Paren          <$> qExpr e
-qExpr (Typed             e qty) = Typed          <$> qExpr e
-                                                 <*> qQualTypeExpr qty
-qExpr (Record           a c fs) =
-  Record a <$> qIdent c <*> mapM (qField qExpr) fs
-qExpr (RecordUpdate       e fs) = RecordUpdate   <$> qExpr e
-                                                 <*> mapM (qField qExpr) fs
-qExpr (Tuple                es) = Tuple          <$> mapM qExpr es
-qExpr (List               a es) = List a         <$> mapM qExpr es
-qExpr (ListCompr          e qs) = ListCompr      <$> qExpr e <*> mapM qStmt qs
-qExpr (EnumFrom              e) = EnumFrom       <$> qExpr e
-qExpr (EnumFromThen      e1 e2) = EnumFromThen   <$> qExpr e1 <*> qExpr e2
-qExpr (EnumFromTo        e1 e2) = EnumFromTo     <$> qExpr e1 <*> qExpr e2
-qExpr (EnumFromThenTo e1 e2 e3) = EnumFromThenTo <$> qExpr e1 <*> qExpr e2
-                                                              <*> qExpr e3
-qExpr (UnaryMinus            e) = UnaryMinus     <$> qExpr e
-qExpr (Apply             e1 e2) = Apply          <$> qExpr e1 <*> qExpr e2
-qExpr (InfixApply     e1 op e2) = InfixApply     <$> qExpr e1 <*> qInfixOp op
-                                                              <*> qExpr e2
-qExpr (LeftSection        e op) = LeftSection  <$> qExpr e <*> qInfixOp op
-qExpr (RightSection       op e) = RightSection <$> qInfixOp op <*> qExpr e
-qExpr (Lambda             ts e) = Lambda       <$> mapM qPattern ts <*> qExpr e
-qExpr (Let                ds e) = Let <$> mapM qDecl ds  <*> qExpr e
-qExpr (Do                sts e) = Do  <$> mapM qStmt sts <*> qExpr e
-qExpr (IfThenElse     e1 e2 e3) = IfThenElse <$> qExpr e1 <*> qExpr e2
-                                                          <*> qExpr e3
-qExpr (Case            ct e as) = Case ct    <$> qExpr e <*> mapM qAlt as
+qExpr l@(Literal             _ _ _) = return l
+qExpr (Variable            spi a v) = Variable     spi a <$> qIdent v
+qExpr (Constructor         spi a c) = Constructor  spi a <$> qIdent c
+qExpr (Paren                 spi e) = Paren        spi   <$> qExpr e
+qExpr (Typed             spi e qty) = Typed        spi   <$> qExpr e
+                                                         <*> qQualTypeExpr qty
+qExpr (Record           spi a c fs) =
+  Record spi a <$> qIdent c <*> mapM (qField qExpr) fs
+qExpr (RecordUpdate       spi e fs) =
+  RecordUpdate spi <$> qExpr e <*> mapM (qField qExpr) fs
+qExpr (Tuple                spi es) = Tuple          spi <$> mapM qExpr es
+qExpr (List               spi a es) = List           spi a <$> mapM qExpr es
+qExpr (ListCompr          spi e qs) = ListCompr      spi <$> qExpr e
+                                                         <*> mapM qStmt qs
+qExpr (EnumFrom              spi e) = EnumFrom       spi <$> qExpr e
+qExpr (EnumFromThen      spi e1 e2) = EnumFromThen   spi <$> qExpr e1
+                                                         <*> qExpr e2
+qExpr (EnumFromTo        spi e1 e2) = EnumFromTo     spi <$> qExpr e1
+                                                         <*> qExpr e2
+qExpr (EnumFromThenTo spi e1 e2 e3) = EnumFromThenTo spi <$> qExpr e1
+                                                         <*> qExpr e2
+                                                         <*> qExpr e3
+qExpr (UnaryMinus            spi e) = UnaryMinus     spi <$> qExpr e
+qExpr (Apply             spi e1 e2) = Apply          spi <$> qExpr e1
+                                                         <*> qExpr e2
+qExpr (InfixApply     spi e1 op e2) = InfixApply     spi <$> qExpr e1
+                                                         <*> qInfixOp op
+                                                         <*> qExpr e2
+qExpr (LeftSection        spi e op) = LeftSection  spi <$> qExpr e
+                                                       <*> qInfixOp op
+qExpr (RightSection       spi op e) = RightSection spi <$> qInfixOp op
+                                                       <*> qExpr e
+qExpr (Lambda             spi ts e) = Lambda       spi <$> mapM qPattern ts
+                                                       <*> qExpr e
+qExpr (Let                spi ds e) = Let spi <$> mapM qDecl ds  <*> qExpr e
+qExpr (Do                spi sts e) = Do  spi <$> mapM qStmt sts <*> qExpr e
+qExpr (IfThenElse     spi e1 e2 e3) = IfThenElse spi <$> qExpr e1 <*> qExpr e2
+                                                     <*> qExpr e3
+qExpr (Case            spi ct e as) = Case spi ct   <$> qExpr e <*> mapM qAlt as
 
 qStmt :: Qual (Statement a)
-qStmt (StmtExpr   e) = StmtExpr <$> qExpr e
-qStmt (StmtBind t e) = StmtBind <$> qPattern t <*> qExpr e
-qStmt (StmtDecl  ds) = StmtDecl <$> mapM qDecl ds
+qStmt (StmtExpr spi   e) = StmtExpr spi <$> qExpr e
+qStmt (StmtBind spi t e) = StmtBind spi <$> qPattern t <*> qExpr e
+qStmt (StmtDecl spi  ds) = StmtDecl spi <$> mapM qDecl ds
 
 qAlt :: Qual (Alt a)
 qAlt (Alt p t rhs) = Alt p <$> qPattern t <*> qRhs rhs
diff --git a/src/Transformations/Simplify.hs b/src/Transformations/Simplify.hs
--- a/src/Transformations/Simplify.hs
+++ b/src/Transformations/Simplify.hs
@@ -35,8 +35,8 @@
 import           Control.Monad.State as S   (State, runState, gets, modify)
 import qualified Data.Map            as Map (Map, empty, insert, lookup)
 
-import Curry.Base.Position
 import Curry.Base.Ident
+import Curry.Base.SpanInfo
 import Curry.Syntax
 
 import Base.Expr
@@ -53,7 +53,7 @@
 -- -----------------------------------------------------------------------------
 
 simplify :: ValueEnv -> Module Type -> (Module Type, ValueEnv)
-simplify vEnv mdl@(Module _ m _ _ _) = (mdl', valueEnv s')
+simplify vEnv mdl@(Module _ _ m _ _ _) = (mdl', valueEnv s')
   where (mdl', s') = S.runState (simModule mdl) (SimplifyState m vEnv 1)
 
 -- -----------------------------------------------------------------------------
@@ -96,8 +96,8 @@
 -- -----------------------------------------------------------------------------
 
 simModule :: Module Type -> SIM (Module Type)
-simModule (Module ps m es is ds) = Module ps m es is
-                                   <$> mapM (simDecl Map.empty) ds
+simModule (Module spi ps m es is ds) = Module spi ps m es is
+                                         <$> mapM (simDecl Map.empty) ds
 
 -- Inline an expression for a variable
 type InlineEnv = Map.Map Ident (Expression Type)
@@ -115,7 +115,7 @@
 
 simRhs :: InlineEnv -> Rhs Type -> SIM (Rhs Type)
 simRhs env (SimpleRhs p e _) = simpleRhs p <$> simExpr env e
-simRhs _   (GuardedRhs  _ _) = error "Simplify.simRhs: guarded rhs"
+simRhs _   (GuardedRhs  _ _ _) = error "Simplify.simRhs: guarded rhs"
 
 -- -----------------------------------------------------------------------------
 -- Inlining of Functions
@@ -147,35 +147,36 @@
 -- because it would require to represent the pattern matching code
 -- explicitly in a Curry expression.
 
-inlineFun :: InlineEnv -> Position -> Lhs Type -> Rhs Type
+inlineFun :: InlineEnv -> SpanInfo -> Lhs Type -> Rhs Type
           -> SIM [Equation Type]
 inlineFun env p lhs rhs = do
   m <- getModuleIdent
   case rhs of
-    SimpleRhs _ (Let [FunctionDecl _ _ f' eqs'] e) _
+    SimpleRhs _ (Let NoSpanInfo [FunctionDecl _ _ f' eqs'] e) _
       | -- @f'@ is not recursive
         f' `notElem` qfv m eqs'
         -- @f'@ does not perform any pattern matching
-        && and [all isVariablePattern ts1 | Equation _ (FunLhs _ ts1) _ <- eqs']
+        && and [all isVariablePattern ts1 | Equation _ (FunLhs _ _ ts1) _ <- eqs']
       -> do
         let a = eqnArity $ head eqs'
             (n, vs', e') = etaReduce 0 [] (reverse (snd $ flatLhs lhs)) e
         if  -- the eta-reduced rhs of @f@ is a call to @f'@
-            e' == Variable (typeOf e') (qualify f')
+            e' == Variable NoSpanInfo (typeOf e') (qualify f')
             -- @f'@ was fully applied before eta-reduction
             && n  == a
           then mapM (mergeEqns p vs') eqs'
           else return [Equation p lhs rhs]
     _ -> return [Equation p lhs rhs]
   where
-  etaReduce n1 vs (VariablePattern ty v : ts1) (Apply e1 (Variable _ v'))
+  etaReduce n1 vs (VariablePattern _ ty v : ts1)
+                  (Apply NoSpanInfo e1 (Variable NoSpanInfo _ v'))
     | qualify v == v' = etaReduce (n1 + 1) ((ty, v) : vs) ts1 e1
   etaReduce n1 vs _ e1 = (n1, vs, e1)
 
-  mergeEqns p1 vs (Equation _ (FunLhs _ ts2) (SimpleRhs p2 e _))
-    = Equation p1 lhs <$> simRhs env (simpleRhs p2 (Let ds e))
+  mergeEqns p1 vs (Equation _ (FunLhs _ _ ts2) (SimpleRhs p2 e _))
+    = Equation p1 lhs <$> simRhs env (simpleRhs p2 (Let NoSpanInfo ds e))
       where
-      ds = zipWith (\t v -> PatternDecl p2 t (simpleRhs p2 (uncurry mkVar v)))
+      ds = zipWith (\t v -> PatternDecl NoSpanInfo t (simpleRhs p2 (uncurry mkVar v)))
                    ts2
                    vs
   mergeEqns _ _ _ = error "Simplify.inlineFun.mergeEqns: no pattern match"
@@ -205,31 +206,32 @@
 -- functions in later phases of the compiler.
 
 simExpr :: InlineEnv -> Expression Type -> SIM (Expression Type)
-simExpr _   l@(Literal     _ _) = return l
-simExpr _   c@(Constructor _ _) = return c
+simExpr _   l@(Literal     _ _ _) = return l
+simExpr _   c@(Constructor _ _ _) = return c
 -- subsitution of variables
-simExpr env v@(Variable   ty x)
+simExpr env v@(Variable   _ ty x)
   | isQualified x = return v
   | otherwise     =
     maybe (return v) (simExpr env . withType ty) (Map.lookup (unqualify x) env)
 -- simplification of application
-simExpr env (Apply       e1 e2) = case e1 of
-  Let ds e'     -> simExpr env (Let ds (Apply e' e2))
-  Case ct e' bs -> simExpr env (Case ct e' (map (applyToAlt e2) bs))
-  _             -> Apply <$> simExpr env e1 <*> simExpr env e2
+simExpr env (Apply       _ e1 e2) = case e1 of
+  Let _ ds e'     -> simExpr env (Let NoSpanInfo ds (Apply NoSpanInfo e' e2))
+  Case _ ct e' bs -> simExpr env (Case NoSpanInfo ct e' (map (applyToAlt e2) bs))
+  _               -> Apply NoSpanInfo <$> simExpr env e1 <*> simExpr env e2
   where
-  applyToAlt e (Alt       p t rhs) = Alt p t (applyToRhs e rhs)
-  applyToRhs e (SimpleRhs p e1' _) = simpleRhs p (Apply e1' e)
-  applyToRhs _ (GuardedRhs    _ _) = error "Simplify.simExpr.applyRhs: Guarded rhs"
+  applyToAlt e (Alt        p t rhs) = Alt p t (applyToRhs e rhs)
+  applyToRhs e (SimpleRhs  p e1' _) = simpleRhs p (Apply NoSpanInfo e1' e)
+  applyToRhs _ (GuardedRhs   _ _ _) = error "Simplify.simExpr.applyRhs: Guarded rhs"
 -- simplification of declarations
-simExpr env (Let          ds e) = do
+simExpr env (Let          _ ds e) = do
   m   <- getModuleIdent
   dss <- mapM sharePatternRhs ds
   simplifyLet env (scc bv (qfv m) (foldr hoistDecls [] (concat dss))) e
-simExpr env (Case      ct e bs) = Case ct <$> simExpr env e
-                                          <*> mapM (simplifyAlt env) bs
-simExpr env (Typed       e qty) = flip Typed qty <$> simExpr env e
-simExpr _   _                   = error "Simplify.simExpr: no pattern match"
+simExpr env (Case      _ ct e bs) =
+  Case NoSpanInfo ct <$> simExpr env e <*> mapM (simplifyAlt env) bs
+simExpr env (Typed       _ e qty) =
+  flip (Typed NoSpanInfo) qty <$> simExpr env e
+simExpr _   _                     = error "Simplify.simExpr: no pattern match"
 
 -- Simplify a case alternative
 simplifyAlt :: InlineEnv -> Alt Type -> SIM (Alt Type)
@@ -241,12 +243,12 @@
 sharePatternRhs :: Decl Type -> SIM [Decl Type]
 --TODO: change to patterns instead of case
 sharePatternRhs (PatternDecl p t rhs) = case t of
-  VariablePattern _ _ -> return [PatternDecl p t rhs]
-  _                   -> do
+  VariablePattern _ _ _ -> return [PatternDecl p t rhs]
+  _                     -> do
     let ty = typeOf t
     v  <- freshIdent patternId
     return [ PatternDecl p t                      (simpleRhs p (mkVar ty v))
-           , PatternDecl p (VariablePattern ty v) rhs
+           , PatternDecl p (VariablePattern NoSpanInfo ty v) rhs
            ]
   where patternId n = mkIdent ("_#pat" ++ show n)
 sharePatternRhs d                     = return [d]
@@ -254,7 +256,7 @@
 -- Lift up nested let declarations in pattern declarations, i.e., replace
 -- @let p = let ds' in e'; ds in e@ by @let ds'; p = e'; ds in e@.
 hoistDecls :: Decl a -> [Decl a] -> [Decl a]
-hoistDecls (PatternDecl p t (SimpleRhs p' (Let ds' e) _)) ds
+hoistDecls (PatternDecl p t (SimpleRhs p' (Let NoSpanInfo ds' e) _)) ds
  = foldr hoistDecls ds (PatternDecl p t (simpleRhs p' e) : ds')
 hoistDecls d ds = d : ds
 
@@ -291,14 +293,14 @@
 
 inlineVars :: InlineEnv -> [Decl Type] -> SIM InlineEnv
 inlineVars env ds = case ds of
-  [PatternDecl _ (VariablePattern _ v) (SimpleRhs _ e _)] -> do
+  [PatternDecl _ (VariablePattern _ _ v) (SimpleRhs _ e _)] -> do
     allowed <- canInlineVar v e
     return $ if allowed then Map.insert v e env else env
   _ -> return env
   where
-  canInlineVar _ (Literal     _ _) = return True
-  canInlineVar _ (Constructor _ _) = return True
-  canInlineVar v (Variable   _ v')
+  canInlineVar _ (Literal     _ _ _) = return True
+  canInlineVar _ (Constructor _ _ _) = return True
+  canInlineVar v (Variable   _ _ v')
     | isQualified v'             = (> 0) <$> getFunArity v'
     | otherwise                  = return $ v /= unqualify v'
   canInlineVar _ _               = return False
@@ -306,13 +308,13 @@
 mkLet' :: ModuleIdent -> [Decl Type] -> Expression Type -> Expression Type
 mkLet' m [FreeDecl p vs] e
   | null vs'  = e
-  | otherwise = Let [FreeDecl p vs'] e         -- remove unused free variables
+  | otherwise = Let NoSpanInfo [FreeDecl p vs'] e -- remove unused free variables
   where vs' = filter ((`elem` qfv m e) . varIdent) vs
-mkLet' m [PatternDecl _ (VariablePattern ty v) (SimpleRhs _ e _)] (Variable _ v')
+mkLet' m [PatternDecl _ (VariablePattern _ ty v) (SimpleRhs _ e _)] (Variable _ _ v')
   | v' == qualify v && v `notElem` qfv m e = withType ty e -- inline single binding
 mkLet' m ds e
-  | null (filter (`elem` qfv m e) (bv ds)) = e -- removed unused bindings
-  | otherwise                              = Let ds e
+  | not (any (`elem` qfv m e) (bv ds)) = e -- removed unused bindings
+  | otherwise                              = Let NoSpanInfo ds e
 
 -- In order to implement lazy pattern matching in local declarations,
 -- pattern declarations 't = e' where 't' is not a variable
@@ -330,15 +332,16 @@
 -- of the let expression.
 expandPatternBindings :: [Ident] -> Decl Type -> SIM [Decl Type]
 expandPatternBindings fvs d@(PatternDecl p t (SimpleRhs _ e _)) = case t of
-  VariablePattern _ _ -> return [d]
-  _                   ->
+  VariablePattern _ _ _ -> return [d]
+  _                     ->
     -- used variables
     mapM mkSelectorDecl (filter ((`elem` fvs) . fst3) (patternVars t))
   where
-    pty = typeOf t -- type of pattern
+    pty = typeOf t -- type of patternNoSpaNoSpanInfonInfo
     mkSelectorDecl (v, _, vty) = do
       let fty = TypeArrow pty vty
       f <- freshIdent (updIdentName (++ '#' : idName v) . fpSelectorId)
       return $ varDecl p vty v $
-        Let [funDecl p fty f [t] (mkVar vty v)] (Apply (mkVar fty f) e)
+        Let NoSpanInfo [funDecl p fty f [t] (mkVar vty v)]
+        (Apply NoSpanInfo (mkVar fty f) e)
 expandPatternBindings _ d = return [d]