haskell-tools-ast-fromghc 0.1.2.0 → 0.1.3.0

raw patch · 17 files changed

+580/−552 lines, 17 filesdep −structural-traversaldep ~haskell-tools-astdep ~safePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: structural-traversal

Dependency ranges changed: haskell-tools-ast, safe

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/AST/FromGHC/Base.hs +62/−59
• Language/Haskell/Tools/AST/FromGHC/Binds.hs +40/−40
• Language/Haskell/Tools/AST/FromGHC/Binds.hs-boot +5/−5
• Language/Haskell/Tools/AST/FromGHC/Decls.hs +115/−115
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs +53/−51
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs-boot +4/−5
• Language/Haskell/Tools/AST/FromGHC/GHCUtils.hs +38/−0
• Language/Haskell/Tools/AST/FromGHC/Kinds.hs +16/−13
• Language/Haskell/Tools/AST/FromGHC/Literals.hs +3/−2
• Language/Haskell/Tools/AST/FromGHC/Modules.hs +77/−97
• Language/Haskell/Tools/AST/FromGHC/Patterns.hs +12/−12
• Language/Haskell/Tools/AST/FromGHC/Stmts.hs +16/−16
• Language/Haskell/Tools/AST/FromGHC/TH.hs +8/−6
• Language/Haskell/Tools/AST/FromGHC/TH.hs-boot +4/−4
• Language/Haskell/Tools/AST/FromGHC/Types.hs +22/−22
• Language/Haskell/Tools/AST/FromGHC/Utils.hs +94/−93
• haskell-tools-ast-fromghc.cabal +11/−12

@@ -35,81 +35,84 @@ import Bag as GHC
 import Data.Data (Data)
 
-import Language.Haskell.Tools.AST (Ann(..), AnnList(..), AnnMaybe(..), SemanticInfo(..), annotation, semanticInfo)
+import Language.Haskell.Tools.AST (Ann(..), AnnList(..), AnnMaybe(..), SemanticInfo(..), RangeStage, Dom, annotation, semanticInfo)
+import Language.Haskell.Tools.AST (NoSemanticInfo(..))
 import qualified Language.Haskell.Tools.AST as AST
 
 import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
 
-trfOperator :: TransformName name res => Located name -> Trf (Ann AST.Operator res)
-trfOperator = trfLoc trfOperator'
+trfOperator :: TransformName n r => Located n -> Trf (Ann AST.Operator (Dom r) RangeStage)
+trfOperator = trfLocNoSema trfOperator'
 
-trfOperator' :: TransformName name res => name -> Trf (AST.Operator res)
+trfOperator' :: TransformName n r => n -> Trf (AST.Operator (Dom r) RangeStage)
 trfOperator' n
-  | isSymOcc (occName n) = AST.NormalOp <$> (addNameInfo n =<< annCont (trfSimpleName' n))
-  | otherwise = AST.BacktickOp <$> (addNameInfo n =<< annLoc loc (trfSimpleName' n))
+  | isSymOcc (occName n) = AST.NormalOp <$> (annCont (createNameInfo (transformName n)) (trfSimpleName' n))
+  | otherwise = AST.BacktickOp <$> (annLoc (createNameInfo (transformName n)) loc (trfSimpleName' n))
      where loc = mkSrcSpan <$> (updateCol (+1) <$> atTheStart) <*> (updateCol (subtract 1) <$> atTheEnd)
 
-trfName :: TransformName name res => Located name -> Trf (Ann AST.Name res)
-trfName = trfLoc trfName'
+trfName :: TransformName n r => Located n -> Trf (Ann AST.Name (Dom r) RangeStage)
+trfName = trfLocNoSema trfName'
 
-trfName' :: TransformName name res => name -> Trf (AST.Name res)
+trfName' :: TransformName n r => n -> Trf (AST.Name (Dom r) RangeStage)
 trfName' n
-  | isSymOcc (occName n) = AST.ParenName <$> (addNameInfo n =<< annLoc loc (trfSimpleName' n))
-  | otherwise = AST.NormalName <$> (addNameInfo n =<< annCont (trfSimpleName' n))
+  | isSymOcc (occName n) = AST.ParenName <$> (annLoc (createNameInfo (transformName n)) loc (trfSimpleName' n))
+  | otherwise = AST.NormalName <$> (annCont (createNameInfo (transformName n)) (trfSimpleName' n))
      where loc = mkSrcSpan <$> (updateCol (+1) <$> atTheStart) <*> (updateCol (subtract 1) <$> atTheEnd)
 
-trfAmbiguousFieldName :: TransformName n res => Located (AmbiguousFieldOcc n) -> Trf (Ann AST.Name res)
+trfAmbiguousFieldName :: TransformName n r => Located (AmbiguousFieldOcc n) -> Trf (Ann AST.Name (Dom r) RangeStage)
 trfAmbiguousFieldName all@(L l af) = trfAmbiguousFieldName' l af
 
-trfAmbiguousFieldName' :: forall n res . (TransformName n res) => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.Name res)
-trfAmbiguousFieldName' l (Unambiguous (L _ rdr) pr) = annLoc (pure l) $ trfName' (unpackPostRn @n rdr pr)
+trfAmbiguousFieldName' :: forall n r . TransformName n r => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.Name (Dom r) RangeStage)
+trfAmbiguousFieldName' l (Unambiguous (L _ rdr) pr) = annLocNoSema (pure l) $ trfName' (unpackPostRn @n rdr pr)
 -- no Id transformation is done, so we can basically ignore the postTC value
 trfAmbiguousFieldName' _ (Ambiguous (L l rdr) _) 
   = do locals <- asks localsInScope
        isDefining <- asks defining
-       annLoc (pure l) 
+       annLocNoSema (pure l) 
          $ AST.NormalName 
-         <$> (annotation .- addSemanticInfo (AmbiguousNameInfo locals isDefining rdr l :: SemanticInfo n)) 
-         <$> (annLoc (pure l) $ AST.nameFromList <$> trfNameStr (rdrNameStr rdr))
+         <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfNameStr (rdrNameStr rdr))
 
 class (DataId n, Eq n, GHCName n) => TransformableName n where
   correctNameString :: n -> Trf String
+  fromGHCName :: GHC.Name -> n 
 
 instance TransformableName RdrName where
   correctNameString = pure . rdrNameStr
+  fromGHCName = rdrName
 
 instance TransformableName GHC.Name where
   correctNameString n = getOriginalName (rdrName n)
-
+  fromGHCName = id
 
 -- | This class allows us to use the same transformation code for multiple variants of the GHC AST.
 -- GHC Name annotated with 'name' can be transformed to our representation with semantic annotations of 'res'.
-class (RangeAnnot res, SemanticAnnot res name, SemanticAnnot res GHC.Name, TransformableName name, HsHasName name) 
+class (TransformableName name, HsHasName name, TransformableName res, HsHasName res, GHCName res) 
         => TransformName name res where
-instance TransformName RdrName AST.RangeInfo where
-instance (RangeAnnot r, SemanticAnnot r GHC.Name) => TransformName GHC.Name r where
+  -- | Demote a given name
+  transformName :: name -> res
 
-addNameInfo :: TransformName n r => n -> Ann AST.SimpleName r -> Trf (Ann AST.SimpleName r)
-addNameInfo name ast = do locals <- asks localsInScope
-                          isDefining <- asks defining
-                          return (annotation .- addSemanticInfo (NameInfo locals isDefining name) $ ast)
+instance {-# OVERLAPPABLE #-} (n ~ r, TransformableName n, HsHasName n) => TransformName n r where
+  transformName = id
 
-trfSimpleName :: TransformName name res => Located name -> Trf (Ann AST.SimpleName res)
-trfSimpleName name@(L l n) = addNameInfo n =<< annLoc (pure l) (trfSimpleName' n)
+instance {-# OVERLAPS #-} (TransformableName res, GHCName res, HsHasName res) => TransformName GHC.Name res where
+  transformName = fromGHCName
 
-trfSimpleName' :: TransformName name res => name -> Trf (AST.SimpleName res)
+trfSimpleName :: TransformName n r => Located n -> Trf (Ann AST.SimpleName (Dom r) RangeStage)
+trfSimpleName name@(L l n) = annLoc (createNameInfo (transformName n)) (pure l) (trfSimpleName' n)
+
+trfSimpleName' :: TransformName n r => n -> Trf (AST.SimpleName (Dom r) RangeStage)
 trfSimpleName' n = AST.nameFromList <$> (trfNameStr =<< correctNameString n)
 
 -- | Creates a qualified name from a name string
-trfNameStr :: RangeAnnot a => String -> Trf (AnnList AST.UnqualName a)
-trfNameStr str = (\loc -> AnnList (toListAnnot "" "" "." loc) $ trfNameStr' str loc) <$> atTheStart
+trfNameStr :: String -> Trf (AnnList AST.UnqualName (Dom r) RangeStage)
+trfNameStr str = makeList "." atTheStart (trfNameStr' str <$> atTheStart)
 
-trfNameStr' :: RangeAnnot a => String -> SrcLoc -> [Ann AST.UnqualName a]
+trfNameStr' :: String -> SrcLoc -> [Ann AST.UnqualName (Dom r) RangeStage]
 trfNameStr' str srcLoc = fst $
   foldl (\(r,loc) np -> let nextLoc = advanceAllSrcLoc loc np
-                         in ( r ++ [Ann (toNodeAnnot $ mkSrcSpan loc nextLoc) (AST.UnqualName np)], advanceAllSrcLoc nextLoc "." ) ) 
+                         in ( r ++ [Ann (noSemaInfo $ AST.NodeSpan (mkSrcSpan loc nextLoc)) (AST.UnqualName np)], advanceAllSrcLoc nextLoc "." ) ) 
   ([], srcLoc) (nameParts str)
   where -- | Move the source location according to a string
         advanceAllSrcLoc :: SrcLoc -> String -> SrcLoc
@@ -128,56 +131,56 @@         nameParts' carry [] = [reverse carry]
         nameParts' carry str = error $ "nameParts': " ++ show carry ++ " " ++ show str
   
-trfModuleName :: RangeAnnot a => Located ModuleName -> Trf (Ann AST.SimpleName a)
-trfModuleName = trfLoc trfModuleName'
+trfModuleName :: Located ModuleName -> Trf (Ann AST.ModuleName (Dom r) RangeStage)
+trfModuleName = trfLocNoSema trfModuleName'
 
-trfModuleName' :: RangeAnnot a => ModuleName -> Trf (AST.SimpleName a)
-trfModuleName' = (AST.nameFromList <$>) . trfNameStr . moduleNameString
+trfModuleName' :: ModuleName -> Trf (AST.ModuleName (Dom r) RangeStage)
+trfModuleName' = pure . AST.ModuleName . moduleNameString
 
-trfFastString :: RangeAnnot a => Located FastString -> Trf (Ann AST.StringNode a)
-trfFastString = trfLoc $ pure . AST.StringNode . unpackFS
+trfFastString :: Located FastString -> Trf (Ann AST.StringNode (Dom r) RangeStage)
+trfFastString = trfLocNoSema $ pure . AST.StringNode . unpackFS
   
-trfDataKeyword :: RangeAnnot a => NewOrData -> Trf (Ann AST.DataOrNewtypeKeyword a)
-trfDataKeyword NewType = annLoc (tokenLoc AnnNewtype) (pure AST.NewtypeKeyword)
-trfDataKeyword DataType = annLoc (tokenLoc AnnData) (pure AST.DataKeyword)
+trfDataKeyword ::  NewOrData -> Trf (Ann AST.DataOrNewtypeKeyword (Dom r) RangeStage)
+trfDataKeyword NewType = annLocNoSema (tokenLoc AnnNewtype) (pure AST.NewtypeKeyword)
+trfDataKeyword DataType = annLocNoSema (tokenLoc AnnData) (pure AST.DataKeyword)
      
-trfCallConv :: RangeAnnot a => Located CCallConv -> Trf (Ann AST.CallConv a)
-trfCallConv = trfLoc trfCallConv'
+trfCallConv :: Located CCallConv -> Trf (Ann AST.CallConv (Dom r) RangeStage)
+trfCallConv = trfLocNoSema trfCallConv'
    
-trfCallConv' :: RangeAnnot a => CCallConv -> Trf (AST.CallConv a)
+trfCallConv' :: CCallConv -> Trf (AST.CallConv (Dom r) RangeStage)
 trfCallConv' CCallConv = pure AST.CCall
 trfCallConv' CApiConv = pure AST.CApi
 trfCallConv' StdCallConv = pure AST.StdCall
 -- trfCallConv' PrimCallConv = 
 trfCallConv' JavaScriptCallConv = pure AST.JavaScript
 
-trfSafety :: RangeAnnot a => SrcSpan -> Located Safety -> Trf (AnnMaybe AST.Safety a)
+trfSafety :: SrcSpan -> Located Safety -> Trf (AnnMaybe AST.Safety (Dom r) RangeStage)
 trfSafety ccLoc lsaf@(L l _) | isGoodSrcSpan l 
-  = makeJust <$> trfLoc (pure . \case
+  = makeJust <$> trfLocNoSema (pure . \case
       PlaySafe -> AST.Safe
       PlayInterruptible -> AST.Interruptible
       PlayRisky -> AST.Unsafe) lsaf
   | otherwise = nothing " " "" (pure $ srcSpanEnd ccLoc)
 
-trfOverlap :: RangeAnnot a => Located OverlapMode -> Trf (Ann AST.OverlapPragma a)
-trfOverlap = trfLoc $ pure . \case
+trfOverlap :: Located OverlapMode -> Trf (Ann AST.OverlapPragma (Dom r) RangeStage)
+trfOverlap = trfLocNoSema $ pure . \case
   NoOverlap _ -> AST.DisableOverlap
   Overlappable _ -> AST.Overlappable
   Overlapping _ -> AST.Overlapping
   Overlaps _ -> AST.Overlaps
   Incoherent _ -> AST.IncoherentOverlap
 
-trfRole :: RangeAnnot a => Located (Maybe Role) -> Trf (Ann AST.Role a)
-trfRole = trfLoc $ \case Just Nominal -> pure AST.Nominal
-                         Just Representational -> pure AST.Representational
-                         Just GHC.Phantom -> pure AST.Phantom
+trfRole :: Located (Maybe Role) -> Trf (Ann AST.Role (Dom r) RangeStage)
+trfRole = trfLocNoSema $ \case Just Nominal -> pure AST.Nominal
+                               Just Representational -> pure AST.Representational
+                               Just GHC.Phantom -> pure AST.Phantom
          
-trfPhase :: RangeAnnot a => Trf SrcLoc -> Activation -> Trf (AnnMaybe AST.PhaseControl a)
+trfPhase :: Trf SrcLoc -> Activation -> Trf (AnnMaybe AST.PhaseControl (Dom r) RangeStage)
 trfPhase l AlwaysActive = nothing "" " " l
-trfPhase _ (ActiveAfter _ pn) = makeJust <$> annLoc (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS) 
-                                                    (AST.PhaseControl <$> nothing "" "" (before AnnCloseS) <*> trfPhaseNum pn)
-trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLoc (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
-                                                     (AST.PhaseControl <$> (makeJust <$> annLoc (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> trfPhaseNum pn)
+trfPhase _ (ActiveAfter _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS) 
+                                                          (AST.PhaseControl <$> nothing "" "" (before AnnCloseS) <*> trfPhaseNum pn)
+trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
+                                                           (AST.PhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> trfPhaseNum pn)
 
-trfPhaseNum :: RangeAnnot a => PhaseNum -> Trf (Ann AST.PhaseNumber a)
-trfPhaseNum i = annLoc (tokenLoc AnnVal) $ pure (AST.PhaseNumber $ fromIntegral i) 
+trfPhaseNum ::  PhaseNum -> Trf (Ann AST.PhaseNumber (Dom r) RangeStage)
+trfPhaseNum i = annLocNoSema (tokenLoc AnnVal) $ pure (AST.PhaseNumber $ fromIntegral i) 

@@ -31,74 +31,74 @@ import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
 
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..))
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfBind :: TransformName n r => Located (HsBind n) -> Trf (Ann AST.ValueBind r)
-trfBind = trfLoc trfBind'
+trfBind :: TransformName n r => Located (HsBind n) -> Trf (Ann AST.ValueBind (Dom r) RangeStage)
+trfBind = trfLocNoSema trfBind'
   
-trfBind' :: TransformName n r => HsBind n -> Trf (AST.ValueBind r)
+trfBind' :: TransformName n r => HsBind n -> Trf (AST.ValueBind (Dom r) RangeStage)
 -- a value binding (not a function)
 trfBind' (FunBind { fun_id = id, fun_matches = MG { mg_alts = unLoc -> [L matchLoc (Match { m_pats = [], m_grhss = GRHSs [L rhsLoc (GRHS [] expr)] (unLoc -> locals) })]} }) 
   = AST.SimpleBind <$> copyAnnot AST.VarPat (define $ trfName id)
-                   <*> addToScope locals (annLoc (combineSrcSpans (getLoc expr) <$> tokenLoc AnnEqual) (AST.UnguardedRhs <$> trfExpr expr))
+                   <*> addToScope locals (annLocNoSema (combineSrcSpans (getLoc expr) <$> tokenLoc AnnEqual) (AST.UnguardedRhs <$> trfExpr expr))
                    <*> addToScope locals (trfWhereLocalBinds locals)
 trfBind' (FunBind id (MG (unLoc -> matches) _ _ _) _ _ _) = AST.FunBind <$> makeNonemptyIndentedList (mapM (trfMatch (unLoc id)) matches)
 trfBind' (PatBind pat (GRHSs rhs (unLoc -> locals)) _ _ _) = AST.SimpleBind <$> trfPattern pat <*> trfRhss rhs <*> trfWhereLocalBinds locals
 trfBind' (AbsBinds _ _ _ _ _) = error "AbsBinds are not allowed as an input to the conversion (they are generated by the type checker)"
 trfBind' (PatSynBind _) = error "Pattern synonym bindings should be recognized on the declaration level"
 
-trfMatch :: TransformName n r => n -> Located (Match n (LHsExpr n)) -> Trf (Ann AST.Match r)
-trfMatch id = trfLoc (trfMatch' id)
+trfMatch :: TransformName n r => n -> Located (Match n (LHsExpr n)) -> Trf (Ann AST.Match (Dom r) RangeStage)
+trfMatch id = trfLocNoSema (trfMatch' id)
 
-trfMatch' :: TransformName n r => n -> Match n (LHsExpr n) -> Trf (AST.Match r)
+trfMatch' :: TransformName n r => n -> Match n (LHsExpr n) -> Trf (AST.Match (Dom r) RangeStage)
 trfMatch' name (Match funid pats typ (GRHSs rhss (unLoc -> locBinds)))
   -- TODO: add the optional typ to pats
   = AST.Match <$> trfMatchLhs name funid pats
               <*> addToScope pats (trfRhss rhss)
               <*> addToScope pats (trfWhereLocalBinds locBinds)
 
-trfMatchLhs :: TransformName n r => n -> MatchFixity n -> [LPat n] -> Trf (Ann AST.MatchLhs r)
+trfMatchLhs :: TransformName n r => n -> MatchFixity n -> [LPat n] -> Trf (Ann AST.MatchLhs (Dom r) RangeStage)
 trfMatchLhs name fb pats 
   = do implicitIdLoc <- mkSrcSpan <$> atTheStart <*> atTheStart
        closeLoc <- srcSpanStart <$> (combineSrcSpans <$> tokenLoc AnnEqual <*> tokenLoc AnnVbar)
        let (n, isInfix) = case fb of NonFunBindMatch -> (L implicitIdLoc name, False)
                                      FunBindMatch n inf -> (n, inf)
        args <- mapM trfPattern pats
-       annLoc (mkSrcSpan <$> atTheStart <*> (pure closeLoc)) $
+       annLocNoSema (mkSrcSpan <$> atTheStart <*> (pure closeLoc)) $
          case (args, isInfix) of 
             (left:right:rest, True) -> AST.InfixLhs left <$> define (trfOperator n) <*> pure right <*> makeList " " (pure closeLoc) (pure rest)
             _                       -> AST.NormalLhs <$> define (trfName n) <*> makeList " " (pure closeLoc) (pure args)
 
-trfRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.Rhs r)
+trfRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.Rhs (Dom r) RangeStage)
 -- the original location on the GRHS misleadingly contains the local bindings
-trfRhss [unLoc -> GRHS [] body] = annLoc (combineSrcSpans (getLoc body) <$> tokenBefore (srcSpanStart $ getLoc body) AnnEqual) 
+trfRhss [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> tokenBefore (srcSpanStart $ getLoc body) AnnEqual) 
                                          (AST.UnguardedRhs <$> trfExpr body)
-trfRhss rhss = annLoc (pure $ collectLocs rhss) 
+trfRhss rhss = annLocNoSema (pure $ collectLocs rhss) 
                       (AST.GuardedRhss . nonemptyAnnList <$> mapM trfGuardedRhs rhss)
                       
-trfGuardedRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.GuardedRhs r)
-trfGuardedRhs = trfLoc $ \(GRHS guards body) 
+trfGuardedRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.GuardedRhs (Dom r) RangeStage)
+trfGuardedRhs = trfLocNoSema $ \(GRHS guards body) 
   -> AST.GuardedRhs . nonemptyAnnList <$> trfScopedSequence trfRhsGuard guards <*> addToScope guards (trfExpr body)
   
-trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.RhsGuard r)
-trfRhsGuard = trfLoc trfRhsGuard'
+trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.RhsGuard (Dom r) RangeStage)
+trfRhsGuard = trfLocNoSema trfRhsGuard'
   
-trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.RhsGuard r)
+trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.RhsGuard (Dom r) RangeStage)
 trfRhsGuard' (BindStmt pat body _ _ _) = AST.GuardBind <$> trfPattern pat <*> trfExpr body
 trfRhsGuard' (BodyStmt body _ _ _) = AST.GuardCheck <$> trfExpr body
 trfRhsGuard' (LetStmt (unLoc -> binds)) = AST.GuardLet <$> trfLocalBinds binds
   
-trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybe AST.LocalBinds r)
+trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybe AST.LocalBinds (Dom r) RangeStage)
 trfWhereLocalBinds EmptyLocalBinds = nothing "" "" atTheEnd
 trfWhereLocalBinds binds
-  = makeJust <$> annLoc (combineSrcSpans (getBindLocs binds) <$> tokenLoc AnnWhere) (AST.LocalBinds <$> addToScope binds (trfLocalBinds binds))
+  = makeJust <$> annLocNoSema (combineSrcSpans (getBindLocs binds) <$> tokenLoc AnnWhere) (AST.LocalBinds <$> addToScope binds (trfLocalBinds binds))
 
 getBindLocs :: HsLocalBinds n -> SrcSpan
 getBindLocs (HsValBinds (ValBindsIn binds sigs)) = foldLocs $ map getLoc (bagToList binds) ++ map getLoc sigs
 getBindLocs (HsValBinds (ValBindsOut binds sigs)) = foldLocs $ map getLoc (concatMap (bagToList . snd) binds) ++ map getLoc sigs
   
-trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnList AST.LocalBind r)
+trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnList AST.LocalBind (Dom r) RangeStage)
 trfLocalBinds (HsValBinds (ValBindsIn binds sigs)) 
   = makeIndentedList (after AnnWhere)
       (orderDefs <$> ((++) <$> mapM (copyAnnot AST.LocalValBind . trfBind) (bagToList binds) 
@@ -108,45 +108,45 @@       (orderDefs <$> ((++) <$> (concat <$> mapM (mapM (copyAnnot AST.LocalValBind . trfBind) . bagToList . snd) binds)
                            <*> mapM trfLocalSig sigs))
              
-trfLocalSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.LocalBind r)
-trfLocalSig = trfLoc $ \case
-  ts@(TypeSig {}) -> AST.LocalSignature <$> annCont (trfTypeSig' ts)
-  (FixSig fs) -> AST.LocalFixity <$> annCont (trfFixitySig fs)
+trfLocalSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.LocalBind (Dom r) RangeStage)
+trfLocalSig = trfLocNoSema $ \case
+  ts@(TypeSig {}) -> AST.LocalSignature <$> annContNoSema (trfTypeSig' ts)
+  (FixSig fs) -> AST.LocalFixity <$> annContNoSema (trfFixitySig fs)
   
-trfTypeSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.TypeSignature r)
-trfTypeSig = trfLoc trfTypeSig'
+trfTypeSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.TypeSignature (Dom r) RangeStage)
+trfTypeSig = trfLocNoSema trfTypeSig'
 
-trfTypeSig' :: TransformName n r => Sig n -> Trf (AST.TypeSignature r)
+trfTypeSig' :: TransformName n r => Sig n -> Trf (AST.TypeSignature (Dom r) RangeStage)
 trfTypeSig' (TypeSig names typ) 
   = defineTypeVars $ AST.TypeSignature <$> makeNonemptyList ", " (mapM trfName names) <*> trfType (hswc_body $ hsib_body typ)
   
-trfFixitySig :: TransformName n r => FixitySig n -> Trf (AST.FixitySignature r)
+trfFixitySig :: TransformName n r => FixitySig n -> Trf (AST.FixitySignature (Dom r) RangeStage)
 trfFixitySig (FixitySig names (Fixity _ prec dir)) 
   = AST.FixitySignature <$> transformDir dir
-                        <*> annLoc (tokenLoc AnnVal) (pure $ AST.Precedence prec) 
+                        <*> annLocNoSema (tokenLoc AnnVal) (pure $ AST.Precedence prec) 
                         <*> (nonemptyAnnList . nub <$> mapM trfOperator names)
   where transformDir InfixL = directionChar (pure AST.AssocLeft)
         transformDir InfixR = directionChar (pure AST.AssocRight)
-        transformDir InfixN = annLoc (srcLocSpan . srcSpanEnd <$> tokenLoc AnnInfix) (pure AST.AssocNone)
+        transformDir InfixN = annLocNoSema (srcLocSpan . srcSpanEnd <$> tokenLoc AnnInfix) (pure AST.AssocNone)
         
-        directionChar = annLoc ((\l -> mkSrcSpan (updateCol (subtract 1) l) l) . srcSpanEnd <$> tokenLoc AnnInfix)
+        directionChar = annLocNoSema ((\l -> mkSrcSpan (updateCol (subtract 1) l) l) . srcSpanEnd <$> tokenLoc AnnInfix)
    
-trfRewriteRule :: TransformName n r => Located (RuleDecl n) -> Trf (Ann AST.Rule r)
-trfRewriteRule = trfLoc $ \(HsRule (L nameLoc (_, ruleName)) act bndrs left _ right _) ->
+trfRewriteRule :: TransformName n r => Located (RuleDecl n) -> Trf (Ann AST.Rule (Dom r) RangeStage)
+trfRewriteRule = trfLocNoSema $ \(HsRule (L nameLoc (_, ruleName)) act bndrs left _ right _) ->
   AST.Rule <$> trfFastString (L nameLoc ruleName) 
            <*> trfPhase (before AnnForall) act
            <*> makeNonemptyList " " (mapM trfRuleBndr bndrs)
            <*> trfExpr left
            <*> trfExpr right
 
-trfRuleBndr :: TransformName n r =>  Located (RuleBndr n) -> Trf (Ann AST.TyVar r)
-trfRuleBndr = trfLoc $ \case (RuleBndr n) -> AST.TyVarDecl <$> trfName n <*> nothing " " "" atTheEnd
-                             (RuleBndrSig n k) -> AST.TyVarDecl <$> trfName n <*> (makeJust <$> (trfKindSig' (hswc_body $ hsib_body k)))
+trfRuleBndr :: TransformName n r =>  Located (RuleBndr n) -> Trf (Ann AST.TyVar (Dom r) RangeStage)
+trfRuleBndr = trfLocNoSema $ \case (RuleBndr n) -> AST.TyVarDecl <$> trfName n <*> nothing " " "" atTheEnd
+                                   (RuleBndrSig n k) -> AST.TyVarDecl <$> trfName n <*> (makeJust <$> (trfKindSig' (hswc_body $ hsib_body k)))
 
-trfMinimalFormula :: TransformName n r => Located (BooleanFormula (Located n)) -> Trf (Ann AST.MinimalFormula r)
-trfMinimalFormula = trfLoc trfMinimalFormula'
+trfMinimalFormula :: TransformName n r => Located (BooleanFormula (Located n)) -> Trf (Ann AST.MinimalFormula (Dom r) RangeStage)
+trfMinimalFormula = trfLocNoSema trfMinimalFormula'
 
-trfMinimalFormula' :: TransformName n r => BooleanFormula (Located n) -> Trf (AST.MinimalFormula r)
+trfMinimalFormula' :: TransformName n r => BooleanFormula (Located n) -> Trf (AST.MinimalFormula (Dom r) RangeStage)
 trfMinimalFormula' (Var name) = AST.MinimalName <$> trfName name
 trfMinimalFormula' (And formulas) = AST.MinimalAnd <$> trfAnnList " & " trfMinimalFormula' formulas
 trfMinimalFormula' (Or formulas) = AST.MinimalOr <$> trfAnnList " | " trfMinimalFormula' formulas

@@ -8,10 +8,10 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.Base
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..))
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnList AST.LocalBind r)
-trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybe AST.LocalBinds r)
-trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.RhsGuard r)
-trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.RhsGuard r)
+trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnList AST.LocalBind (Dom r) RangeStage)
+trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybe AST.LocalBinds (Dom r) RangeStage)
+trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.RhsGuard (Dom r) RangeStage)
+trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.RhsGuard (Dom r) RangeStage)

@@ -35,16 +35,16 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), RangeWithName, getRange)
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), getRange, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
 import Debug.Trace
 
-trfDecls :: TransformName n r => [LHsDecl n] -> Trf (AnnList AST.Decl r)
+trfDecls :: TransformName n r => [LHsDecl n] -> Trf (AnnList AST.Decl (Dom r) RangeStage)
 -- TODO: filter documentation comments
 trfDecls decls = addToScope decls $ makeIndentedListNewlineBefore atTheEnd (mapM trfDecl decls)
 
-trfDeclsGroup :: forall n r . TransformName n r => HsGroup n -> Trf (AnnList AST.Decl r)
+trfDeclsGroup :: forall n r . TransformName n r => HsGroup n -> Trf (AnnList AST.Decl (Dom r) RangeStage)
 trfDeclsGroup (HsGroup vals splices tycls insts derivs fixities defaults foreigns warns anns rules vects docs) 
   = addAllToScope $ makeIndentedListNewlineBefore atTheEnd (fmap (orderDefs . concat) $ sequence $
       [ trfBindOrSig vals
@@ -61,20 +61,20 @@       , mapM (trfDecl . (fmap VectD)) vects
       -- , mapM (trfDecl . (fmap DocD)) docs
       ])
-  where trfBindOrSig :: HsValBinds n -> Trf [Ann AST.Decl r]
+  where trfBindOrSig :: HsValBinds n -> Trf [Ann AST.Decl (Dom r) RangeStage]
         trfBindOrSig (getBindsAndSigs -> (sigs, binds))
-          = (++) <$> mapM (trfLoc trfVal) (bagToList binds)
-                 <*> mapM (trfLoc trfSig) sigs
+          = (++) <$> mapM (trfLocNoSema trfVal) (bagToList binds)
+                 <*> mapM (trfLocNoSema trfSig) sigs
         addAllToScope = addToCurrentScope vals . addToCurrentScope tycls . addToCurrentScope foreigns
            
            
-trfDecl :: TransformName n r => Located (HsDecl n) -> Trf (Ann AST.Decl r)
-trfDecl = trfLoc $ \case
+trfDecl :: TransformName n r => Located (HsDecl n) -> Trf (Ann AST.Decl (Dom r) RangeStage)
+trfDecl = trfLocNoSema $ \case
   TyClD (FamDecl (FamilyDecl (ClosedTypeFamily typeEqs) name tyVars kindSig _)) 
     -> AST.ClosedTypeFamilyDecl <$> focusAfter AnnType (createDeclHead name tyVars) 
                                 <*> trfFamilyKind kindSig 
                                 <*> trfTypeEqs typeEqs
-  TyClD (FamDecl fd) -> AST.TypeFamilyDecl <$> annCont (trfTypeFam' fd)
+  TyClD (FamDecl fd) -> AST.TypeFamilyDecl <$> annContNoSema (trfTypeFam' fd)
   TyClD (SynDecl name vars rhs _) 
     -> AST.TypeDecl <$> between AnnType AnnEqual (createDeclHead name vars) <*> trfType rhs
   TyClD (DataDecl name vars (HsDataDefn nd ctx _ kind cons derivs) _ _) 
@@ -104,21 +104,21 @@   SigD sig -> trfSig sig
   DerivD (DerivDecl t overlap) -> AST.DerivDecl <$> trfMaybe "" "" trfOverlap overlap <*> trfInstanceRule (hsib_body t)
   -- TODO: INLINE, SPECIALIZE, MINIMAL, VECTORISE pragmas, Warnings, Annotations, rewrite rules, role annotations
-  RuleD (HsRules _ rules) -> AST.PragmaDecl <$> annCont (AST.RulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
+  RuleD (HsRules _ rules) -> AST.PragmaDecl <$> annContNoSema (AST.RulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
   RoleAnnotD (RoleAnnotDecl name roles) -> AST.RoleDecl <$> trfSimpleName name <*> makeList " " atTheEnd (mapM trfRole roles)
   DefD (DefaultDecl types) -> AST.DefaultDecl . nonemptyAnnList <$> mapM trfType types
   ForD (ForeignImport name (hsib_body -> typ) _ (CImport ccall safe _ _ _)) 
     -> AST.ForeignImport <$> trfCallConv ccall <*> trfSafety (getLoc ccall) safe <*> define (trfName name) <*> trfType typ
   ForD (ForeignExport name (hsib_body -> typ) _ (CExport (L l (CExportStatic _ _ ccall)) _)) 
-    -> AST.ForeignExport <$> annLoc (pure l) (trfCallConv' ccall) <*> trfName name <*> trfType typ
-  SpliceD (SpliceDecl (unLoc -> spl) _) -> AST.SpliceDecl <$> (annCont $ trfSplice' spl)
+    -> AST.ForeignExport <$> annLocNoSema (pure l) (trfCallConv' ccall) <*> trfName name <*> trfType typ
+  SpliceD (SpliceDecl (unLoc -> spl) _) -> AST.SpliceDecl <$> (annContNoSema $ trfSplice' spl)
   AnnD (HsAnnotation stxt subject expr) 
-    -> AST.PragmaDecl <$> annCont (AST.AnnPragma <$> trfAnnotationSubject stxt subject (srcSpanStart $ getLoc expr) <*> trfExpr expr)
+    -> AST.PragmaDecl <$> annContNoSema (AST.AnnPragma <$> trfAnnotationSubject stxt subject (srcSpanStart $ getLoc expr) <*> trfExpr expr)
   d -> error ("Illegal declaration: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")")
 
 trfGADT :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n) 
                                  -> Maybe (Located (HsKind n)) -> [Located (ConDecl n)] 
-                                 -> Maybe (Located [LHsSigType n]) -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.Decl r)
+                                 -> Maybe (Located [LHsSigType n]) -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.Decl (Dom r) RangeStage)
 trfGADT nd name vars ctx kind cons derivs ctxTok consLoc
   = AST.GDataDecl <$> trfDataKeyword nd
                   <*> trfCtx (after ctxTok) ctx
@@ -129,7 +129,7 @@ 
 trfDataDef :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n) 
                                      -> [Located (ConDecl n)] -> Maybe (Located [LHsSigType n]) 
-                                     -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.Decl r)
+                                     -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.Decl (Dom r) RangeStage)
 trfDataDef nd name vars ctx cons derivs ctxTok consLoc
   = AST.DataDecl <$> trfDataKeyword nd
                  <*> trfCtx (after ctxTok) ctx
@@ -137,38 +137,38 @@                  <*> makeListBefore "=" " | " consLoc (mapM trfConDecl cons)
                  <*> trfMaybe "" "" trfDerivings derivs
 
-trfVal :: TransformName n r => HsBindLR n n -> Trf (AST.Decl r)
-trfVal (PatSynBind psb) = AST.PatternSynonymDecl <$> annCont (trfPatternSynonym psb)
-trfVal bind = AST.ValueBinding <$> (annCont $ trfBind' bind)
+trfVal :: TransformName n r => HsBindLR n n -> Trf (AST.Decl (Dom r) RangeStage)
+trfVal (PatSynBind psb) = AST.PatternSynonymDecl <$> annContNoSema (trfPatternSynonym psb)
+trfVal bind = AST.ValueBinding <$> (annContNoSema $ trfBind' bind)
 
-trfSig :: TransformName n r => Sig n -> Trf (AST.Decl r)
-trfSig (ts @ (TypeSig {})) = AST.TypeSigDecl <$> defineTypeVars (annCont $ trfTypeSig' ts)
-trfSig (FixSig fs) = AST.FixityDecl <$> (annCont $ trfFixitySig fs)
+trfSig :: TransformName n r => Sig n -> Trf (AST.Decl (Dom r) RangeStage)
+trfSig (ts @ (TypeSig {})) = AST.TypeSigDecl <$> defineTypeVars (annContNoSema $ trfTypeSig' ts)
+trfSig (FixSig fs) = AST.FixityDecl <$> (annContNoSema $ trfFixitySig fs)
 trfSig (PatSynSig id typ) 
-  = AST.PatTypeSigDecl <$> annCont (AST.PatternTypeSignature <$> trfName id <*> trfType (hsib_body typ))
+  = AST.PatTypeSigDecl <$> annContNoSema (AST.PatternTypeSignature <$> trfName id <*> trfType (hsib_body typ))
 trfSig (InlineSig name (InlinePragma _ Inlinable _ phase _)) 
-  = AST.PragmaDecl <$> annCont (AST.InlinablePragma <$> trfPhase (pure $ srcSpanStart $ getLoc name) phase <*> trfName name)
+  = AST.PragmaDecl <$> annContNoSema (AST.InlinablePragma <$> trfPhase (pure $ srcSpanStart $ getLoc name) phase <*> trfName name)
 trfSig (InlineSig name (InlinePragma src inl _ phase cl)) 
   = do rng <- asks contRange
        let parts = map getLoc $ splitLocated (L rng src)
-       AST.PragmaDecl <$> annCont ((case inl of Inline -> AST.InlinePragma; NoInline -> AST.NoInlinePragma) 
+       AST.PragmaDecl <$> annContNoSema ((case inl of Inline -> AST.InlinePragma; NoInline -> AST.NoInlinePragma) 
                                      <$> trfConlike parts cl 
                                      <*> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
                                      <*> trfName name)
 trfSig (SpecSig name (map hsib_body -> types) (inl_act -> phase)) 
-  = AST.PragmaDecl <$> annCont (AST.SpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
+  = AST.PragmaDecl <$> annContNoSema (AST.SpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
                                                      <*> trfName name 
                                                      <*> (orderAnnList <$> trfAnnList ", " trfType' types))
 trfSig s = error ("Illegal signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
 
-trfConlike :: RangeAnnot a => [SrcSpan] -> RuleMatchInfo -> Trf (AnnMaybe AST.ConlikeAnnot a)
-trfConlike parts ConLike = makeJust <$> annLoc (pure $ parts !! 2) (pure AST.ConlikeAnnot)
+trfConlike :: [SrcSpan] -> RuleMatchInfo -> Trf (AnnMaybe AST.ConlikeAnnot (Dom r) RangeStage)
+trfConlike parts ConLike = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.ConlikeAnnot)
 trfConlike parts FunLike = nothing " " "" (pure $ srcSpanEnd $ parts !! 1)
 
-trfConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.ConDecl r)
-trfConDecl = trfLoc trfConDecl'
+trfConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.ConDecl (Dom r) RangeStage)
+trfConDecl = trfLocNoSema trfConDecl'
 
-trfConDecl' :: TransformName n r => ConDecl n -> Trf (AST.ConDecl r)
+trfConDecl' :: TransformName n r => ConDecl n -> Trf (AST.ConDecl (Dom r) RangeStage)
 trfConDecl' (ConDeclH98 { con_name = name, con_details = PrefixCon args })
   = AST.ConDecl <$> define (trfName name) <*> makeList " " atTheEnd (mapM trfType args)
 trfConDecl' (ConDeclH98 { con_name = name, con_details = RecCon (unLoc -> flds) })
@@ -176,110 +176,110 @@ trfConDecl' (ConDeclH98 { con_name = name, con_details = InfixCon t1 t2 })
   = AST.InfixConDecl <$> trfType t1 <*> define (trfOperator name) <*> trfType t2
 
-trfGADTConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.GadtConDecl r)
-trfGADTConDecl = trfLoc $ \(ConDeclGADT { con_names = names, con_type = hsib_body -> typ })
+trfGADTConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.GadtConDecl (Dom r) RangeStage)
+trfGADTConDecl = trfLocNoSema $ \(ConDeclGADT { con_names = names, con_type = hsib_body -> typ })
   -> AST.GadtConDecl <$> define (trfAnnList ", " trfName' names) 
                      <*> trfGadtConType typ
 
-trfGadtConType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.GadtConType r)
-trfGadtConType = trfLoc $ \case 
+trfGadtConType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.GadtConType (Dom r) RangeStage)
+trfGadtConType = trfLocNoSema $ \case 
   HsFunTy (cleanHsType . unLoc -> HsRecTy flds) resType 
     -> AST.GadtRecordType <$> between AnnOpenC AnnCloseC (trfAnnList ", " trfFieldDecl' flds) 
                           <*> trfType resType
-  typ -> AST.GadtNormalType <$> annCont (trfType' typ)
+  typ -> AST.GadtNormalType <$> annContNoSema (trfType' typ)
 
-trfFieldDecl :: TransformName n r => Located (ConDeclField n) -> Trf (Ann AST.FieldDecl r)
-trfFieldDecl = trfLoc trfFieldDecl'
+trfFieldDecl :: TransformName n r => Located (ConDeclField n) -> Trf (Ann AST.FieldDecl (Dom r) RangeStage)
+trfFieldDecl = trfLocNoSema trfFieldDecl'
 
-trfFieldDecl' :: TransformName n r => ConDeclField n -> Trf (AST.FieldDecl r)
+trfFieldDecl' :: TransformName n r => ConDeclField n -> Trf (AST.FieldDecl (Dom r) RangeStage)
 trfFieldDecl' (ConDeclField names typ _) = AST.FieldDecl <$> (define $ nonemptyAnnList <$> mapM (trfName . getFieldOccName) names) <*> trfType typ
 
-trfDerivings :: TransformName n r => Located [LHsSigType n] -> Trf (Ann AST.Deriving r)
-trfDerivings = trfLoc $ \case
+trfDerivings :: TransformName n r => Located [LHsSigType n] -> Trf (Ann AST.Deriving (Dom r) RangeStage)
+trfDerivings = trfLocNoSema $ \case
   [hsib_body -> typ@(unLoc -> HsTyVar cls)] -> AST.DerivingOne <$> trfInstanceHead typ
   derivs -> AST.Derivings <$> trfAnnList ", " trfInstanceHead' (map hsib_body derivs)
   
-trfInstanceRule :: TransformName n r => Located (HsType n) -> Trf (Ann AST.InstanceRule r)
-trfInstanceRule = trfLoc (trfInstanceRule' . cleanHsType)
+trfInstanceRule :: TransformName n r => Located (HsType n) -> Trf (Ann AST.InstanceRule (Dom r) RangeStage)
+trfInstanceRule = trfLocNoSema (trfInstanceRule' . cleanHsType)
 
-trfInstanceRule' :: TransformName n r => HsType n -> Trf (AST.InstanceRule r)
+trfInstanceRule' :: TransformName n r => HsType n -> Trf (AST.InstanceRule (Dom r) RangeStage)
 trfInstanceRule' (HsForAllTy bndrs (unLoc -> HsQualTy ctx typ))
-  = AST.InstanceRule <$> (makeJust <$> annLoc (pure $ collectLocs bndrs) (trfBindings bndrs)) 
+  = AST.InstanceRule <$> (makeJust <$> annLocNoSema (pure $ collectLocs bndrs) (trfBindings bndrs)) 
                      <*> trfCtx (after AnnDot) ctx
                      <*> trfInstanceHead typ
 trfInstanceRule' (HsQualTy ctx typ) = AST.InstanceRule <$> nothing "" " . " atTheStart 
                                                        <*> trfCtx atTheStart ctx
                                                        <*> trfInstanceHead typ
 trfInstanceRule' (HsParTy typ) = AST.InstanceParen <$> trfInstanceRule typ
-trfInstanceRule' (HsTyVar tv) = instanceHead $ annCont (AST.InstanceHeadCon <$> trfName tv)
-trfInstanceRule' (HsAppTy t1 t2) = instanceHead $ annCont (AST.InstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2)
+trfInstanceRule' (HsTyVar tv) = instanceHead $ annContNoSema (AST.InstanceHeadCon <$> trfName tv)
+trfInstanceRule' (HsAppTy t1 t2) = instanceHead $ annContNoSema (AST.InstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2)
 trfInstanceRule' t = error (showSDocUnsafe $ ppr t)
 
-instanceHead :: RangeAnnot r => Trf (Ann AST.InstanceHead r) -> Trf (AST.InstanceRule r)
+instanceHead :: Trf (Ann AST.InstanceHead (Dom r) RangeStage) -> Trf (AST.InstanceRule (Dom r) RangeStage)
 instanceHead hd = AST.InstanceRule <$> (nothing "" " . " atTheStart) <*> (nothing " " "" atTheStart) <*> hd
                             
-makeInstanceRuleTyVars :: TransformName n r => Located n -> HsImplicitBndrs n [LHsType n] -> Trf (Ann AST.InstanceRule r)
-makeInstanceRuleTyVars n vars = annCont
+makeInstanceRuleTyVars :: TransformName n r => Located n -> HsImplicitBndrs n [LHsType n] -> Trf (Ann AST.InstanceRule (Dom r) RangeStage)
+makeInstanceRuleTyVars n vars = annContNoSema
   $ AST.InstanceRule <$> nothing "" " . " atTheStart
                      <*> nothing " " "" atTheStart
-                     <*> foldl (\c t -> annLoc (pure $ combineSrcSpans (getLoc n) (getLoc t)) $ AST.InstanceHeadApp <$> c <*> (trfType t))
+                     <*> foldl (\c t -> annLocNoSema (pure $ combineSrcSpans (getLoc n) (getLoc t)) $ AST.InstanceHeadApp <$> c <*> (trfType t))
                                (copyAnnot AST.InstanceHeadCon (trfName n))
                                (hsib_body vars)
 
-trfInstanceHead :: TransformName n r => Located (HsType n) -> Trf (Ann AST.InstanceHead r)
-trfInstanceHead = trfLoc trfInstanceHead'
+trfInstanceHead :: TransformName n r => Located (HsType n) -> Trf (Ann AST.InstanceHead (Dom r) RangeStage)
+trfInstanceHead = trfLocNoSema trfInstanceHead'
 
-trfInstanceHead' :: TransformName n r => HsType n -> Trf (AST.InstanceHead r)
+trfInstanceHead' :: TransformName n r => HsType n -> Trf (AST.InstanceHead (Dom r) RangeStage)
 trfInstanceHead' = trfInstanceHead'' . cleanHsType where
   trfInstanceHead'' (HsForAllTy [] (unLoc -> t)) = trfInstanceHead' t
   trfInstanceHead'' (HsTyVar tv) = AST.InstanceHeadCon <$> trfName tv
   trfInstanceHead'' (HsAppTy t1 t2) = AST.InstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2
   trfInstanceHead'' (HsParTy typ) = AST.InstanceHeadParen <$> trfInstanceHead typ
   trfInstanceHead'' (HsOpTy t1 op t2) 
-    = AST.InstanceHeadApp <$> (annLoc (pure $ combineSrcSpans (getLoc t1) (getLoc op))
+    = AST.InstanceHeadApp <$> (annLocNoSema (pure $ combineSrcSpans (getLoc t1) (getLoc op))
                                       (AST.InstanceHeadInfix <$> trfType t1 <*> trfName op)) 
                           <*> trfType t2
   trfInstanceHead'' t = error ("Illegal instance head: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
  
-trfTypeEqs :: TransformName n r => Maybe [Located (TyFamInstEqn n)] -> Trf (AnnList AST.TypeEqn r)
+trfTypeEqs :: TransformName n r => Maybe [Located (TyFamInstEqn n)] -> Trf (AnnList AST.TypeEqn (Dom r) RangeStage)
 trfTypeEqs Nothing = makeList "\n" (after AnnWhere) (pure [])
 trfTypeEqs (Just eqs) = makeNonemptyList "\n" (mapM trfTypeEq eqs)
 
-trfTypeEq :: TransformName n r => Located (TyFamInstEqn n) -> Trf (Ann AST.TypeEqn r)
-trfTypeEq = trfLoc $ \(TyFamEqn name pats rhs) 
+trfTypeEq :: TransformName n r => Located (TyFamInstEqn n) -> Trf (Ann AST.TypeEqn (Dom r) RangeStage)
+trfTypeEq = trfLocNoSema $ \(TyFamEqn name pats rhs) 
   -> AST.TypeEqn <$> defineTypeVars (focusBefore AnnEqual (combineTypes name (hsib_body pats))) <*> trfType rhs
-  where combineTypes :: TransformName n r => Located n -> [LHsType n] -> Trf (Ann AST.Type r)
+  where combineTypes :: TransformName n r => Located n -> [LHsType n] -> Trf (Ann AST.Type (Dom r) RangeStage)
         combineTypes name (lhs : rhs : rest) | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
-          = annCont $ AST.TyInfix <$> trfType lhs <*> trfOperator name <*> trfType rhs
-        combineTypes name pats = wrapTypes (annLoc (pure $ getLoc name) (AST.TyVar <$> trfName name)) pats
+          = annContNoSema $ AST.TyInfix <$> trfType lhs <*> trfOperator name <*> trfType rhs
+        combineTypes name pats = wrapTypes (annLocNoSema (pure $ getLoc name) (AST.TyVar <$> trfName name)) pats
 
-        wrapTypes :: TransformName n r => Trf (Ann AST.Type r) -> [LHsType n] -> Trf (Ann AST.Type r)
+        wrapTypes :: TransformName n r => Trf (Ann AST.Type (Dom r) RangeStage) -> [LHsType n] -> Trf (Ann AST.Type (Dom r) RangeStage)
         wrapTypes base pats 
           = foldl (\t p -> do typ <- t
-                              annLoc (pure $ combineSrcSpans (getRange $ _annotation typ) (getLoc p)) 
+                              annLocNoSema (pure $ combineSrcSpans (getRange typ) (getLoc p)) 
                                      (AST.TyApp <$> pure typ <*> trfType p)) base pats
                  
-trfFunDeps :: TransformName n r => [Located (FunDep (Located n))] -> Trf (AnnMaybe AST.FunDeps r)
+trfFunDeps :: TransformName n r => [Located (FunDep (Located n))] -> Trf (AnnMaybe AST.FunDeps (Dom r) RangeStage)
 trfFunDeps [] = nothing "| " "" $ focusBeforeIfPresent AnnWhere atTheEnd
-trfFunDeps fundeps = makeJust <$> annLoc (combineSrcSpans (collectLocs fundeps) <$> tokenLoc AnnVbar) 
+trfFunDeps fundeps = makeJust <$> annLocNoSema (combineSrcSpans (collectLocs fundeps) <$> tokenLoc AnnVbar) 
                                          (AST.FunDeps <$> trfAnnList ", " trfFunDep' fundeps)
   
-trfFunDep' :: TransformName n r => FunDep (Located n) -> Trf (AST.FunDep r)
+trfFunDep' :: TransformName n r => FunDep (Located n) -> Trf (AST.FunDep (Dom r) RangeStage)
 trfFunDep' (lhs, rhs) = AST.FunDep <$> trfAnnList ", " trfName' lhs <*> trfAnnList ", " trfName' rhs
 
-createDeclHead :: TransformName n r => Located n -> LHsQTyVars n -> Trf (Ann AST.DeclHead r)
+createDeclHead :: TransformName n r => Located n -> LHsQTyVars n -> Trf (Ann AST.DeclHead (Dom r) RangeStage)
 createDeclHead name (hsq_explicit -> lhs : rhs : rest)
   | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
   -- infix declaration
   = wrapDeclHead rest
-      $ annLoc (addParenLocs $ getLoc lhs `combineSrcSpans` getLoc rhs) 
+      $ annLocNoSema (addParenLocs $ getLoc lhs `combineSrcSpans` getLoc rhs) 
                (AST.DHInfix <$> defineTypeVars (trfTyVar lhs) <*> define (trfOperator name) <*> defineTypeVars (trfTyVar rhs))
 createDeclHead name vars = defineTypeVars $ wrapDeclHead (hsq_explicit vars) (define $ copyAnnot AST.DeclHead (trfName name))
 
-wrapDeclHead :: TransformName n r => [LHsTyVarBndr n] -> Trf (Ann AST.DeclHead r) -> Trf (Ann AST.DeclHead r)
+wrapDeclHead :: TransformName n r => [LHsTyVarBndr n] -> Trf (Ann AST.DeclHead (Dom r) RangeStage) -> Trf (Ann AST.DeclHead (Dom r) RangeStage)
 wrapDeclHead vars base
   = foldl (\t p -> do typ <- t 
-                      annLoc (addParenLocs $ combineSrcSpans (getRange $ _annotation typ) (getLoc p)) 
+                      annLocNoSema (addParenLocs $ combineSrcSpans (getRange typ) (getLoc p)) 
                              (AST.DHApp typ <$> trfTyVar p)
           ) base vars
 
@@ -292,13 +292,13 @@       
          
 createClassBody :: TransformName n r => [LSig n] -> LHsBinds n -> [LFamilyDecl n] 
-                               -> [LTyFamDefltEqn n] -> Trf (AnnMaybe AST.ClassBody r)
+                               -> [LTyFamDefltEqn n] -> Trf (AnnMaybe AST.ClassBody (Dom r) RangeStage)
 createClassBody sigs binds typeFams typeFamDefs 
   = do isThereWhere <- isGoodSrcSpan <$> (tokenLoc AnnWhere)
        if isThereWhere 
-         then makeJust <$> annLoc (combinedLoc <$> tokenLoc AnnWhere) 
-                                  (AST.ClassBody <$> makeList "" (after AnnWhere) 
-                                                                 (orderDefs . concat <$> sequenceA allDefs))
+         then makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere) 
+                                        (AST.ClassBody <$> makeList "" (after AnnWhere) 
+                                                                       (orderDefs . concat <$> sequenceA allDefs))
          else nothing " where " "" atTheEnd
   where combinedLoc wh = foldl combineSrcSpans wh allLocs
         allLocs = map getLoc sigs ++ map getLoc (bagToList binds) ++ map getLoc typeFams ++ map getLoc typeFamDefs
@@ -308,20 +308,20 @@         getFams = mapM (copyAnnot AST.ClsTypeFam . trfTypeFam) typeFams
         getFamDefs = mapM trfTypeFamDef typeFamDefs
        
-trfClassElemSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.ClassElement r)
-trfClassElemSig = trfLoc $ \case
-  TypeSig names typ -> AST.ClsSig <$> (annCont $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
+trfClassElemSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.ClassElement (Dom r) RangeStage)
+trfClassElemSig = trfLocNoSema $ \case
+  TypeSig names typ -> AST.ClsSig <$> (annContNoSema $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
                                   <*> trfType (hswc_body $ hsib_body typ))
   ClassOpSig True [name] typ -> AST.ClsDefSig <$> trfName name <*> trfType (hsib_body typ)
-  ClassOpSig False names typ -> AST.ClsSig <$> (annCont $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
+  ClassOpSig False names typ -> AST.ClsSig <$> (annContNoSema $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
                                            <*> trfType (hsib_body typ))
   MinimalSig _ formula -> AST.ClsMinimal <$> trfMinimalFormula formula
   s -> error ("Illegal signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
          
-trfTypeFam :: TransformName n r => Located (FamilyDecl n) -> Trf (Ann AST.TypeFamily r)
-trfTypeFam = trfLoc trfTypeFam'
+trfTypeFam :: TransformName n r => Located (FamilyDecl n) -> Trf (Ann AST.TypeFamily (Dom r) RangeStage)
+trfTypeFam = trfLocNoSema trfTypeFam'
 
-trfTypeFam' :: TransformName n r => FamilyDecl n -> Trf (AST.TypeFamily r)
+trfTypeFam' :: TransformName n r => FamilyDecl n -> Trf (AST.TypeFamily (Dom r) RangeStage)
 trfTypeFam' (FamilyDecl DataFamily name tyVars kindSig _)
   = AST.DataFamily <$> (case unLoc kindSig of KindSig _ -> between AnnData AnnDcolon; _ -> id) (createDeclHead name tyVars) 
                    <*> trfFamilyKind kindSig
@@ -329,15 +329,15 @@   = AST.TypeFamily <$> (case unLoc kindSig of KindSig _ -> between AnnType AnnDcolon; _ -> id) (createDeclHead name tyVars) 
                    <*> trfFamilyResultSig kindSig injectivity
 
-trfTypeFamDef :: TransformName n r => Located (TyFamDefltEqn n) -> Trf (Ann AST.ClassElement r)
-trfTypeFamDef = trfLoc $ \(TyFamEqn con pats rhs) 
+trfTypeFamDef :: TransformName n r => Located (TyFamDefltEqn n) -> Trf (Ann AST.ClassElement (Dom r) RangeStage)
+trfTypeFamDef = trfLocNoSema $ \(TyFamEqn con pats rhs) 
   -> AST.ClsTypeDef <$> between AnnType AnnEqual (createDeclHead con pats) <*> trfType rhs
           
-trfInstBody :: TransformName n r => LHsBinds n -> [LSig n] -> [LTyFamInstDecl n] -> [LDataFamInstDecl n] -> Trf (AnnMaybe AST.InstBody r)
+trfInstBody :: TransformName n r => LHsBinds n -> [LSig n] -> [LTyFamInstDecl n] -> [LDataFamInstDecl n] -> Trf (AnnMaybe AST.InstBody (Dom r) RangeStage)
 trfInstBody binds sigs fams dats = do
     wh <- tokenLoc AnnWhere
     if isGoodSrcSpan wh then
-      makeJust <$> annLoc (combinedLoc <$> tokenLoc AnnWhere) 
+      makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere) 
                           (AST.InstBody <$> (makeList "" (after AnnWhere) 
                                                          (orderDefs . concat <$> sequenceA allDefs)))
     else nothing " where " "" atTheEnd
@@ -349,33 +349,33 @@         getFams = mapM trfInstTypeFam fams
         getDats = mapM trfInstDataFam dats
           
-trfClassInstSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.InstBodyDecl r)
-trfClassInstSig = trfLoc $ \case
-  TypeSig names typ -> AST.InstBodyTypeSig <$> (annCont $ AST.TypeSignature <$> makeNonemptyList ", " (mapM trfName names) 
+trfClassInstSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.InstBodyDecl (Dom r) RangeStage)
+trfClassInstSig = trfLocNoSema $ \case
+  TypeSig names typ -> AST.InstBodyTypeSig <$> (annContNoSema $ AST.TypeSignature <$> makeNonemptyList ", " (mapM trfName names) 
                                            <*> trfType (hswc_body $ hsib_body typ))
-  ClassOpSig _ names typ -> AST.InstBodyTypeSig <$> (annCont $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
+  ClassOpSig _ names typ -> AST.InstBodyTypeSig <$> (annContNoSema $ AST.TypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
                                                 <*> trfType (hsib_body typ))
   SpecInstSig _ typ -> AST.SpecializeInstance <$> trfType (hsib_body typ)
   s -> error ("Illegal class instance signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
           
-trfInstTypeFam :: TransformName n r => Located (TyFamInstDecl n) -> Trf (Ann AST.InstBodyDecl r)
+trfInstTypeFam :: TransformName n r => Located (TyFamInstDecl n) -> Trf (Ann AST.InstBodyDecl (Dom r) RangeStage)
 trfInstTypeFam (unLoc -> TyFamInstDecl eqn _) = copyAnnot AST.InstBodyTypeDecl (trfTypeEq eqn)
 
-trfInstDataFam :: TransformName n r => Located (DataFamInstDecl n) -> Trf (Ann AST.InstBodyDecl r)
-trfInstDataFam = trfLoc $ \case 
+trfInstDataFam :: TransformName n r => Located (DataFamInstDecl n) -> Trf (Ann AST.InstBodyDecl (Dom r) RangeStage)
+trfInstDataFam = trfLocNoSema $ \case 
   (DataFamInstDecl tc (hsib_body -> pats) (HsDataDefn dn ctx _ _ cons derivs) _) 
     -> AST.InstBodyDataDecl 
          <$> trfDataKeyword dn 
-         <*> annLoc (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
-                    (AST.InstanceRule <$> nothing "" " . " atTheStart
-                                      <*> trfCtx atTheStart ctx 
-                                      <*> foldr (\t r -> annLoc (combineSrcSpans (getLoc t) . getRange . _annotation <$> r) 
-                                                                (AST.InstanceHeadApp <$> r <*> (trfType t))) 
-                                                (copyAnnot AST.InstanceHeadCon (trfName tc)) pats)
+         <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
+                          (AST.InstanceRule <$> nothing "" " . " atTheStart
+                                            <*> trfCtx atTheStart ctx 
+                                            <*> foldr (\t r -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r) 
+                                                                            (AST.InstanceHeadApp <$> r <*> (trfType t))) 
+                                                      (copyAnnot AST.InstanceHeadCon (trfName tc)) pats)
          <*> trfAnnList "" trfConDecl' cons
          <*> trfMaybe " deriving " "" trfDerivings derivs
           
-trfPatternSynonym :: forall n r . TransformName n r => PatSynBind n n -> Trf (AST.PatternSynonym r)
+trfPatternSynonym :: forall n r . TransformName n r => PatSynBind n n -> Trf (AST.PatternSynonym (Dom r) RangeStage)
 trfPatternSynonym (PSB id _ lhs def dir)
   = let sep = case dir of ImplicitBidirectional -> AnnEqual
                           _                     -> AnnLarrow
@@ -385,40 +385,40 @@                                _                 -> []
         changedRhs = biplateRef .- (\n -> case lookup n rewrites of Just x -> x; Nothing -> n) $ def
      in AST.PatternSynonym <$> trfPatSynLhs id lhs
-                           <*> annLoc rhsLoc (trfPatSynRhs dir changedRhs)
+                           <*> annLocNoSema rhsLoc (trfPatSynRhs dir changedRhs)
 
-  where trfPatSynLhs :: TransformName n r => Located n -> HsPatSynDetails (Located n) -> Trf (Ann AST.PatSynLhs r)
+  where trfPatSynLhs :: TransformName n r => Located n -> HsPatSynDetails (Located n) -> Trf (Ann AST.PatSynLhs (Dom r) RangeStage)
         trfPatSynLhs id (PrefixPatSyn args)
-          = annLoc (pure $ foldLocs (getLoc id : map getLoc args)) $ AST.NormalPatSyn <$> trfName id <*> trfAnnList " " trfName' args
+          = annLocNoSema (pure $ foldLocs (getLoc id : map getLoc args)) $ AST.NormalPatSyn <$> trfName id <*> trfAnnList " " trfName' args
         trfPatSynLhs op (InfixPatSyn lhs rhs)
-          = annLoc (pure $ getLoc lhs `combineSrcSpans` getLoc rhs) $ AST.InfixPatSyn <$> trfName lhs <*> trfOperator op <*> trfName rhs
+          = annLocNoSema (pure $ getLoc lhs `combineSrcSpans` getLoc rhs) $ AST.InfixPatSyn <$> trfName lhs <*> trfOperator op <*> trfName rhs
         trfPatSynLhs id (RecordPatSyn flds)
-          = annLoc (mkSrcSpan (srcSpanStart (getLoc id)) <$> before AnnEqual) 
+          = annLocNoSema (mkSrcSpan (srcSpanStart (getLoc id)) <$> before AnnEqual) 
               $ AST.RecordPatSyn <$> trfName id <*> trfAnnList ", " trfName' (map recordPatSynSelectorId flds)
 
-        trfPatSynRhs :: TransformName n r => HsPatSynDir n -> Located (Pat n) -> Trf (AST.PatSynRhs r)
+        trfPatSynRhs :: TransformName n r => HsPatSynDir n -> Located (Pat n) -> Trf (AST.PatSynRhs (Dom r) RangeStage)
         trfPatSynRhs ImplicitBidirectional pat = AST.BidirectionalPatSyn <$> trfPattern pat <*> nothing " where " "" atTheEnd
         trfPatSynRhs (ExplicitBidirectional mg) pat = AST.BidirectionalPatSyn <$> trfPattern pat <*> (makeJust <$> trfPatSynWhere mg)
         trfPatSynRhs Unidirectional pat = AST.OneDirectionalPatSyn <$> trfPattern pat
-        trfPatSynWhere :: TransformName n r => MatchGroup n (LHsExpr n) -> Trf (Ann AST.PatSynWhere r)
-        trfPatSynWhere (MG { mg_alts = alts }) = annLoc (pure $ getLoc alts) (AST.PatSynWhere <$> makeIndentedList (after AnnWhere) (mapM (trfMatch (unLoc id)) (unLoc alts)))
+        trfPatSynWhere :: TransformName n r => MatchGroup n (LHsExpr n) -> Trf (Ann AST.PatSynWhere (Dom r) RangeStage)
+        trfPatSynWhere (MG { mg_alts = alts }) = annLocNoSema (pure $ getLoc alts) (AST.PatSynWhere <$> makeIndentedList (after AnnWhere) (mapM (trfMatch (unLoc id)) (unLoc alts)))
 
-trfFamilyKind :: TransformName n r => Located (FamilyResultSig n) -> Trf (AnnMaybe AST.KindConstraint r)
+trfFamilyKind :: TransformName n r => Located (FamilyResultSig n) -> Trf (AnnMaybe AST.KindConstraint (Dom r) RangeStage)
 trfFamilyKind (unLoc -> fr) = case fr of
   NoSig -> nothing "" " " atTheEnd
   KindSig k -> trfKindSig (Just k)
 
-trfFamilyResultSig :: TransformName n r => Located (FamilyResultSig n) -> Maybe (LInjectivityAnn n) -> Trf (AnnMaybe AST.TypeFamilySpec r)
+trfFamilyResultSig :: TransformName n r => Located (FamilyResultSig n) -> Maybe (LInjectivityAnn n) -> Trf (AnnMaybe AST.TypeFamilySpec (Dom r) RangeStage)
 trfFamilyResultSig (L l fr) Nothing = case fr of 
   NoSig -> nothing "" " " atTheEnd
-  KindSig k -> makeJust <$> (annLoc (pure l) $ AST.TypeFamilyKind <$> trfKindSig' k)
+  KindSig k -> makeJust <$> (annLocNoSema (pure l) $ AST.TypeFamilyKind <$> trfKindSig' k)
 trfFamilyResultSig _ (Just (L l (InjectivityAnn n deps))) 
-  = makeJust <$> (annLoc (pure l) $ AST.TypeFamilyInjectivity <$> (annCont $ AST.InjectivityAnn <$> trfName n <*> trfAnnList ", " trfName' deps))
+  = makeJust <$> (annLocNoSema (pure l) $ AST.TypeFamilyInjectivity <$> (annContNoSema $ AST.InjectivityAnn <$> trfName n <*> trfAnnList ", " trfName' deps))
 
-trfAnnotationSubject :: TransformName n r => SourceText -> AnnProvenance n -> SrcLoc -> Trf (Ann AST.AnnotationSubject r)
+trfAnnotationSubject :: TransformName n r => SourceText -> AnnProvenance n -> SrcLoc -> Trf (Ann AST.AnnotationSubject (Dom r) RangeStage)
 trfAnnotationSubject stxt subject payloadEnd
   = do payloadStart <- advanceStr stxt <$> atTheStart
-       case subject of ValueAnnProvenance name@(L l _) -> annLoc (pure l) (AST.NameAnnotation <$> trfName name)
-                       TypeAnnProvenance name@(L l _) -> annLoc (pure $ mkSrcSpan payloadStart (srcSpanEnd l)) 
-                                                                (AST.TypeAnnotation <$> trfName name)
-                       ModuleAnnProvenance -> annLoc (pure $ mkSrcSpan payloadStart payloadEnd) (pure AST.ModuleAnnotation)
+       case subject of ValueAnnProvenance name@(L l _) -> annLocNoSema (pure l) (AST.NameAnnotation <$> trfName name)
+                       TypeAnnProvenance name@(L l _) -> annLocNoSema (pure $ mkSrcSpan payloadStart (srcSpanEnd l)) 
+                                                                      (AST.TypeAnnotation <$> trfName name)
+                       ModuleAnnProvenance -> annLocNoSema (pure $ mkSrcSpan payloadStart payloadEnd) (pure AST.ModuleAnnotation)

@@ -11,6 +11,7 @@ import Control.Monad.Reader
 import Control.Reference
 
+import GHC
 import SrcLoc as GHC
 import RdrName as GHC
 import HsTypes as GHC
@@ -22,6 +23,7 @@ import ApiAnnotation as GHC
 import FastString as GHC
 import Outputable as GHC
+import PrelNames as GHC
 
 import Language.Haskell.Tools.AST.FromGHC.Base
 import Language.Haskell.Tools.AST.FromGHC.Types
@@ -34,36 +36,38 @@ import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
 
-import Language.Haskell.Tools.AST (Ann(..), AnnList(..))
+import Language.Haskell.Tools.AST (Ann(..), AnnList(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
 import Debug.Trace
 
-trfExpr :: forall n r . TransformName n r => Located (HsExpr n) -> Trf (Ann AST.Expr r)
+trfExpr :: forall n r . TransformName n r => Located (HsExpr n) -> Trf (Ann AST.Expr (Dom r) RangeStage)
 -- correction for empty cases (TODO: put of and {} inside)
 trfExpr (L l cs@(HsCase expr (unLoc . mg_alts -> []))) 
-  = addScopeInfo @n =<< annLoc (pure $ combineSrcSpans l (getLoc expr)) (trfExpr' cs)
-trfExpr e = addScopeInfo @n =<< trfLoc trfExpr' e
+  = annLoc createScopeInfo (pure $ combineSrcSpans l (getLoc expr)) (trfExpr' cs)
+trfExpr e = trfLoc trfExpr' createScopeInfo e
 
-addScopeInfo :: forall n r . TransformName n r => Ann AST.Expr r -> Trf (Ann AST.Expr r)
-addScopeInfo expr = do scope <- asks localsInScope
-                       return $ AST.annotation .- addSemanticInfo (AST.ScopeInfo scope :: AST.SemanticInfo n) $ expr
+createScopeInfo :: Trf AST.ScopeInfo
+createScopeInfo = do scope <- asks localsInScope
+                     return (AST.ScopeInfo scope)
 
-trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.Expr r)
+trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.Expr (Dom r) RangeStage)
 trfExpr' (HsVar name) = AST.Var <$> trfName name
 trfExpr' (HsRecFld fld) = AST.Var <$> (asks contRange >>= \l -> trfAmbiguousFieldName' l fld)
-trfExpr' (HsIPVar (HsIPName ip)) = AST.Var <$> annCont (AST.NormalName <$> annCont (AST.nameFromList <$> trfNameStr (unpackFS ip)))
-trfExpr' (HsOverLit (ol_val -> val)) = AST.Lit <$> annCont (trfOverloadedLit val)
-trfExpr' (HsLit val) = AST.Lit <$> annCont (trfLiteral' val)
+trfExpr' (HsIPVar (HsIPName ip)) = AST.Var <$> annContNoSema (AST.NormalName <$> annCont (createImplicitNameInfo (unpackFS ip)) (AST.nameFromList <$> trfNameStr (unpackFS ip)))
+trfExpr' (HsOverLit (ol_val -> val)) = AST.Lit <$> annContNoSema (trfOverloadedLit val)
+trfExpr' (HsLit val) = AST.Lit <$> annContNoSema (trfLiteral' val)
 trfExpr' (HsLam (unLoc . mg_alts -> [unLoc -> Match _ pats _ (GRHSs [unLoc -> GRHS [] expr] (unLoc -> EmptyLocalBinds))]))
   = AST.Lambda <$> (trfAnnList " " trfPattern' pats) <*> addToScope pats (trfExpr expr)
 trfExpr' (HsLamCase _ (unLoc . mg_alts -> matches)) = AST.LamCase <$> trfAnnList " " trfAlt' matches
 trfExpr' (HsApp e1 e2) = AST.App <$> trfExpr e1 <*> trfExpr e2
 trfExpr' (OpApp e1 (unLoc -> HsVar op) _ e2) 
   = AST.InfixApp <$> trfExpr e1 <*> trfOperator op <*> trfExpr e2
-trfExpr' (NegApp e _) = AST.PrefixApp <$> annLoc loc (AST.NormalOp <$> annLoc loc (AST.nameFromList <$> trfNameStr "-"))
+trfExpr' (NegApp e _) = AST.PrefixApp <$> annLocNoSema loc (AST.NormalOp <$> annLoc info loc (AST.nameFromList <$> trfNameStr "-"))
                                       <*> trfExpr e
   where loc = mkSrcSpan <$> atTheStart <*> (pure $ srcSpanStart (getLoc e))
+        info = createNameInfo =<< (fromMaybe (error "minus operation is not found") <$> lift negateOpName)
+        negateOpName = getFromNameUsing (\n -> (\case Just (AnId id) -> Just id; _ -> Nothing) <$> lookupName n) negateName
 trfExpr' (HsPar (unLoc -> SectionL expr (unLoc -> HsVar op))) = AST.LeftSection <$> trfExpr expr <*> trfOperator op
 trfExpr' (HsPar (unLoc -> SectionR (unLoc -> HsVar op) expr)) = AST.RightSection <$> trfOperator op <*> trfExpr expr
 trfExpr' (HsPar expr) = AST.Paren <$> trfExpr expr
@@ -75,10 +79,10 @@                (do locs <- elemLocs
                    makeList ", " atTheEnd $ mapM trfTupSecElem (zip (map unLoc tupArgs) locs))
   where wrap = if box == Boxed then AST.TupleSection else AST.UnboxedTupSec
-        trfTupSecElem :: forall n r . TransformName n r => (HsTupArg n, SrcSpan) -> Trf (Ann AST.TupSecElem r)
+        trfTupSecElem :: forall n r . TransformName n r => (HsTupArg n, SrcSpan) -> Trf (Ann AST.TupSecElem (Dom r) RangeStage)
         trfTupSecElem (Present e, l) 
-          = annLoc (pure l) (AST.Present <$> (addScopeInfo @n =<< annCont (trfExpr' (unLoc e))))
-        trfTupSecElem (Missing _, l) = annLoc (pure l) (pure AST.Missing)
+          = annLocNoSema (pure l) (AST.Present <$> (annCont createScopeInfo (trfExpr' (unLoc e))))
+        trfTupSecElem (Missing _, l) = annLocNoSema (pure l) (pure AST.Missing)
         
         elemLocs :: Trf [SrcSpan]
         elemLocs = do r <- asks contRange
@@ -96,12 +100,12 @@ trfExpr' (HsIf _ expr thenE elseE) = AST.If <$> trfExpr expr <*> trfExpr thenE <*> trfExpr elseE
 trfExpr' (HsMultiIf _ parts) = AST.MultiIf <$> trfAnnList "" trfGuardedCaseRhs' parts
 trfExpr' (HsLet (unLoc -> binds) expr) = addToScope binds (AST.Let <$> trfLocalBinds binds <*> trfExpr expr)
-trfExpr' (HsDo DoExpr (unLoc -> stmts) _) = AST.Do <$> annLoc (tokenLoc AnnDo) (pure AST.DoKeyword) 
+trfExpr' (HsDo DoExpr (unLoc -> stmts) _) = AST.Do <$> annLocNoSema (tokenLoc AnnDo) (pure AST.DoKeyword) 
                                                    <*> makeNonemptyIndentedList (trfScopedSequence trfDoStmt stmts)
 trfExpr' (HsDo MDoExpr (unLoc -> [unLoc -> RecStmt { recS_stmts = stmts }, lastStmt]) _) 
-  = AST.Do <$> annLoc (tokenLoc AnnMdo) (pure AST.MDoKeyword)
+  = AST.Do <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.MDoKeyword)
            <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt (stmts ++ [lastStmt])))
-trfExpr' (HsDo MDoExpr (unLoc -> stmts) _) = AST.Do <$> annLoc (tokenLoc AnnMdo) (pure AST.MDoKeyword)
+trfExpr' (HsDo MDoExpr (unLoc -> stmts) _) = AST.Do <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.MDoKeyword)
                                                     <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt stmts))
 -- TODO: scoping
 trfExpr' (HsDo ListComp (unLoc -> stmts) _)
@@ -129,74 +133,72 @@ trfExpr' (PArrSeq _ (FromThenTo from step to)) 
   = AST.ParArrayEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> trfExpr to
 -- TODO: SCC, CORE, GENERATED annotations
-trfExpr' (HsBracket brack) = AST.BracketExpr <$> annCont (trfBracket' brack)
-trfExpr' (HsRnBracketOut brack _) = AST.BracketExpr <$> annCont (trfBracket' brack)
-trfExpr' (HsTcBracketOut brack _) = AST.BracketExpr <$> annCont (trfBracket' brack)
-trfExpr' (HsSpliceE qq@(HsQuasiQuote {})) = AST.QuasiQuoteExpr <$> annCont (trfQuasiQuotation' qq)
-trfExpr' (HsSpliceE splice) = AST.Splice <$> annCont (trfSplice' splice)
+trfExpr' (HsBracket brack) = AST.BracketExpr <$> annContNoSema (trfBracket' brack)
+trfExpr' (HsSpliceE qq@(HsQuasiQuote {})) = AST.QuasiQuoteExpr <$> annContNoSema (trfQuasiQuotation' qq)
+trfExpr' (HsSpliceE splice) = AST.Splice <$> annContNoSema (trfSplice' splice)
 trfExpr' (HsProc pat cmdTop) = AST.Proc <$> trfPattern pat <*> trfCmdTop cmdTop
 trfExpr' (HsStatic expr) = AST.StaticPtr <$> trfExpr expr
 trfExpr' (HsAppType expr typ) = AST.ExplTypeApp <$> trfExpr expr <*> trfType (hswc_body typ)
 trfExpr' t = error ("Illegal expression: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
   
-trfFieldInits :: TransformName n r => HsRecFields n (LHsExpr n) -> Trf (AnnList AST.FieldUpdate r)
+trfFieldInits :: TransformName n r => HsRecFields n (LHsExpr n) -> Trf (AnnList AST.FieldUpdate (Dom r) RangeStage)
 trfFieldInits (HsRecFields fields dotdot) 
   = do cont <- asks contRange
        makeList ", " (before AnnCloseC)
          $ ((++) <$> mapM trfFieldInit (filter ((cont /=) . getLoc) fields) 
-                  <*> (if isJust dotdot then (:[]) <$> annLoc (tokenLoc AnnDotdot) 
-                                                              (pure AST.FieldWildcard) 
+                  <*> (if isJust dotdot then (:[]) <$> annLocNoSema (tokenLoc AnnDotdot) 
+                                                                    (pure AST.FieldWildcard) 
                                         else pure []))
   
-trfFieldInit :: TransformName n r => Located (HsRecField n (LHsExpr n)) -> Trf (Ann AST.FieldUpdate r)
-trfFieldInit = trfLoc $ \case
+trfFieldInit :: TransformName n r => Located (HsRecField n (LHsExpr n)) -> Trf (Ann AST.FieldUpdate (Dom r) RangeStage)
+trfFieldInit = trfLocNoSema $ \case
   HsRecField id _ True -> AST.FieldPun <$> trfName (getFieldOccName id)
   HsRecField id val False -> AST.NormalFieldUpdate <$> trfName (getFieldOccName id) <*> trfExpr val
   
-trfFieldUpdate :: TransformName n r => HsRecField' (AmbiguousFieldOcc n) (LHsExpr n) -> Trf (AST.FieldUpdate r)
+trfFieldUpdate :: TransformName n r => HsRecField' (AmbiguousFieldOcc n) (LHsExpr n) -> Trf (AST.FieldUpdate (Dom r) RangeStage)
 trfFieldUpdate (HsRecField id _ True) = AST.FieldPun <$> trfAmbiguousFieldName id
 trfFieldUpdate (HsRecField id val False) = AST.NormalFieldUpdate <$> trfAmbiguousFieldName id <*> trfExpr val
 
-trfAlt :: TransformName n r => Located (Match n (LHsExpr n)) -> Trf (Ann AST.Alt r)
-trfAlt = trfLoc trfAlt'
+trfAlt :: TransformName n r => Located (Match n (LHsExpr n)) -> Trf (Ann AST.Alt (Dom r) RangeStage)
+trfAlt = trfLocNoSema trfAlt'
 
-trfAlt' :: TransformName n r => Match n (LHsExpr n) -> Trf (AST.Alt r)
+trfAlt' :: TransformName n r => Match n (LHsExpr n) -> Trf (AST.Alt (Dom r) RangeStage)
 trfAlt' = gTrfAlt' trfExpr
 
-gTrfAlt' :: TransformName n r => (Located (ge n) -> Trf (Ann ae r)) -> Match n (Located (ge n)) -> Trf (AST.Alt' ae r)
+gTrfAlt' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Match n (Located (ge n)) -> Trf (AST.Alt' ae (Dom r) RangeStage)
 gTrfAlt' te (Match _ [pat] typ (GRHSs rhss (unLoc -> locBinds)))
   = AST.Alt <$> trfPattern pat <*> gTrfCaseRhss te rhss <*> trfWhereLocalBinds locBinds
   
-trfCaseRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.CaseRhs r)
+trfCaseRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.CaseRhs (Dom r) RangeStage)
 trfCaseRhss = gTrfCaseRhss trfExpr
 
-gTrfCaseRhss :: TransformName n r => (Located (ge n) -> Trf (Ann ae r)) -> [Located (GRHS n (Located (ge n)))] -> Trf (Ann (AST.CaseRhs' ae) r)
-gTrfCaseRhss te [unLoc -> GRHS [] body] = annLoc (combineSrcSpans (getLoc body) <$> tokenLocBack AnnRarrow) 
+gTrfCaseRhss :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> [Located (GRHS n (Located (ge n)))] -> Trf (Ann (AST.CaseRhs' ae) (Dom r) RangeStage)
+gTrfCaseRhss te [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> tokenLocBack AnnRarrow) 
                                                  (AST.UnguardedCaseRhs <$> te body)
-gTrfCaseRhss te rhss = annLoc (pure $ collectLocs rhss) 
+gTrfCaseRhss te rhss = annLocNoSema (pure $ collectLocs rhss) 
                               (AST.GuardedCaseRhss <$> trfAnnList ";" (gTrfGuardedCaseRhs' te) rhss)
   
-trfGuardedCaseRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.GuardedCaseRhs r)
-trfGuardedCaseRhs = trfLoc trfGuardedCaseRhs' 
+trfGuardedCaseRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.GuardedCaseRhs (Dom r) RangeStage)
+trfGuardedCaseRhs = trfLocNoSema trfGuardedCaseRhs' 
 
-trfGuardedCaseRhs' :: TransformName n r => GRHS n (LHsExpr n) -> Trf (AST.GuardedCaseRhs r)
+trfGuardedCaseRhs' :: TransformName n r => GRHS n (LHsExpr n) -> Trf (AST.GuardedCaseRhs (Dom r) RangeStage)
 trfGuardedCaseRhs' = gTrfGuardedCaseRhs' trfExpr
 
-gTrfGuardedCaseRhs' :: TransformName n r => (Located (ge n) -> Trf (Ann ae r)) -> GRHS n (Located (ge n)) -> Trf (AST.GuardedCaseRhs' ae r)
+gTrfGuardedCaseRhs' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> GRHS n (Located (ge n)) -> Trf (AST.GuardedCaseRhs' ae (Dom r) RangeStage)
 gTrfGuardedCaseRhs' te (GRHS guards body) = AST.GuardedCaseRhs <$> trfAnnList " " trfRhsGuard' guards <*> te body
 
-trfCmdTop :: TransformName n r => Located (HsCmdTop n) -> Trf (Ann AST.Cmd r)
+trfCmdTop :: TransformName n r => Located (HsCmdTop n) -> Trf (Ann AST.Cmd (Dom r) RangeStage)
 trfCmdTop (L _ (HsCmdTop cmd _ _ _)) = trfCmd cmd
 
-trfCmd :: TransformName n r => Located (HsCmd n) -> Trf (Ann AST.Cmd r)
-trfCmd = trfLoc trfCmd'
+trfCmd :: TransformName n r => Located (HsCmd n) -> Trf (Ann AST.Cmd (Dom r) RangeStage)
+trfCmd = trfLocNoSema trfCmd'
 
-trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.Cmd r)
+trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.Cmd (Dom r) RangeStage)
 trfCmd' (HsCmdArrApp left right _ typ dir) = AST.ArrowAppCmd <$> trfExpr left <*> op <*> trfExpr right 
-  where op = case (typ, dir) of (HsFirstOrderApp, False) -> annLoc (tokenLoc Annrarrowtail) (pure AST.RightAppl)
-                                (HsFirstOrderApp, True) -> annLoc (tokenLoc Annlarrowtail) (pure AST.LeftAppl)
-                                (HsHigherOrderApp, False) -> annLoc (tokenLoc AnnRarrowtail) (pure AST.RightHighApp)
-                                (HsHigherOrderApp, True) -> annLoc (tokenLoc AnnLarrowtail) (pure AST.LeftHighApp)
+  where op = case (typ, dir) of (HsFirstOrderApp, False) -> annLocNoSema (tokenLoc Annrarrowtail) (pure AST.RightAppl)
+                                (HsFirstOrderApp, True) -> annLocNoSema (tokenLoc Annlarrowtail) (pure AST.LeftAppl)
+                                (HsHigherOrderApp, False) -> annLocNoSema (tokenLoc AnnRarrowtail) (pure AST.RightHighApp)
+                                (HsHigherOrderApp, True) -> annLocNoSema (tokenLoc AnnLarrowtail) (pure AST.LeftHighApp)
                                                                        -- FIXME: needs a before 
 trfCmd' (HsCmdArrForm expr _ cmds) = AST.ArrowFormCmd <$> trfExpr expr <*> makeList " " (before AnnClose) (mapM trfCmdTop cmds)
 trfCmd' (HsCmdApp cmd expr) = AST.AppCmd <$> trfCmd cmd <*> trfExpr expr
@@ -204,7 +206,7 @@   = AST.LambdaCmd <$> trfAnnList " " trfPattern' pats <*> trfCmd body
 trfCmd' (HsCmdPar cmd) = AST.ParenCmd <$> trfCmd cmd
 trfCmd' (HsCmdCase expr (MG (unLoc -> alts) _ _ _)) 
-  = AST.CaseCmd <$> trfExpr expr <*> makeNonemptyIndentedList (mapM (trfLoc (gTrfAlt' trfCmd)) alts) 
+  = AST.CaseCmd <$> trfExpr expr <*> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfAlt' trfCmd)) alts) 
 trfCmd' (HsCmdIf _ pred thenExpr elseExpr) = AST.IfCmd <$> trfExpr pred <*> trfCmd thenExpr <*> trfCmd elseExpr
 trfCmd' (HsCmdLet (unLoc -> binds) cmd) = addToScope binds (AST.LetCmd <$> trfLocalBinds binds <*> trfCmd cmd)
-trfCmd' (HsCmdDo (unLoc -> stmts) _) = AST.DoCmd <$> makeNonemptyIndentedList (mapM (trfLoc (gTrfDoStmt' trfCmd)) stmts)+trfCmd' (HsCmdDo (unLoc -> stmts) _) = AST.DoCmd <$> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfDoStmt' trfCmd)) stmts)

@@ -7,10 +7,9 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.Base
-import Language.Haskell.Tools.AST (Ann(..))
+import Language.Haskell.Tools.AST (Ann(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfExpr :: TransformName n r => Located (HsExpr n) -> Trf (Ann AST.Expr r)
-trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.Expr r)
-
-trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.Cmd r)+trfExpr :: TransformName n r => Located (HsExpr n) -> Trf (Ann AST.Expr (Dom r) RangeStage)
+trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.Expr (Dom r) RangeStage)
+trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.Cmd (Dom r) RangeStage)

@@ -3,10 +3,14 @@            , FlexibleInstances
            , ScopedTypeVariables
            , ViewPatterns
+           , LambdaCase
            #-}
 module Language.Haskell.Tools.AST.FromGHC.GHCUtils where
 
 import Data.List
+import qualified Data.Map as Map
+import Data.Generics.Uniplate.Operations
+import Data.Generics.Uniplate.Data
 
 import GHC
 import Bag
@@ -15,9 +19,15 @@ import Name
 import Outputable
 import SrcLoc
+import ConLike
+import Id
+import PatSyn
+import Type
+import TysWiredIn
 
 class OutputableBndr name => GHCName name where 
   rdrName :: name -> RdrName
+  getFromNameUsing :: Applicative f => (Name -> Ghc (f Id)) -> Name -> Ghc (f name)
   getBindsAndSigs :: HsValBinds name -> ([LSig name], LHsBinds name)
   nameFromId :: Id -> name
   unpackPostRn :: RdrName -> PostRn name name -> name
@@ -26,6 +36,7 @@ 
 instance GHCName RdrName where
   rdrName = id
+  getFromNameUsing _ n = return $ pure (nameRdrName n)
   getBindsAndSigs (ValBindsIn binds sigs) = (sigs, binds)
   nameFromId = nameRdrName . getName
   unpackPostRn rdr _ = rdr
@@ -37,6 +48,7 @@     
 instance GHCName GHC.Name where
   rdrName = nameRdrName
+  getFromNameUsing f n = fmap nameFromId <$> f n
   getBindsAndSigs (ValBindsOut bindGroups sigs) = (sigs, unionManyBags (map snd bindGroups))
   nameFromId = getName
   unpackPostRn _ a = a
@@ -48,6 +60,32 @@ 
 getFieldOccName' :: GHCName n => FieldOcc n -> n
 getFieldOccName' (FieldOcc (L _ rdr) postRn) = unpackPostRn rdr postRn
+
+
+
+-- | Loading ids for top-level ghc names
+getTopLevelId :: GHC.Name -> Ghc (Maybe GHC.Id)
+getTopLevelId name = 
+    lookupName name >>= \case
+      Just (AnId id) -> return (Just id)
+      Just (AConLike (RealDataCon dc)) -> return $ Just $ mkVanillaGlobal name (dataConUserType dc)
+      Just (AConLike (PatSynCon ps)) -> return $ Just $ mkVanillaGlobal name (createPatSynType ps)
+      Just (ATyCon tc) -> return $ Just $ mkVanillaGlobal name (tyConKind tc)
+      Nothing -> return Nothing
+  where createPatSynType patSyn = case patSynSig patSyn of (_, _, _, _, args, res) -> mkFunTys args res
+
+-- | Loading ids for local ghc names
+getLocalId :: LHsBinds Id -> GHC.Name -> Ghc (Maybe GHC.Id)
+getLocalId bnds name = case Map.lookup name mapping of
+    Just id -> return (Just id)
+    Nothing | isTyVarName name
+               -- unit type is for cases we don't know the kind
+            -> return $ Just $ mkVanillaGlobal name unitTy
+    Nothing -> return Nothing
+  where mapping = Map.fromList $ map (\id -> (getName id, id)) $ extractTypes bnds
+        extractTypes :: LHsBinds Id -> [Id]
+        extractTypes = concatMap universeBi . bagToList
+
 
 
 class HsHasName a where

@@ -1,4 +1,6 @@-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns
+           , TypeFamilies 
+           #-}
 module Language.Haskell.Tools.AST.FromGHC.Kinds where
 
 import SrcLoc as GHC
@@ -19,22 +21,22 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..))
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), Dom, RangeStage, SemanticInfo, NoSemanticInfo)
 import qualified Language.Haskell.Tools.AST as AST
 
 import Debug.Trace
 
-trfKindSig :: TransformName n r => Maybe (LHsKind n) -> Trf (AnnMaybe AST.KindConstraint r)
+trfKindSig :: TransformName n r => Maybe (LHsKind n) -> Trf (AnnMaybe AST.KindConstraint (Dom r) RangeStage)
 trfKindSig = trfMaybe "" "" trfKindSig'
 
-trfKindSig' :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.KindConstraint r)
-trfKindSig' k = annLoc (combineSrcSpans (getLoc k) <$> (tokenBefore (srcSpanStart (getLoc k)) AnnDcolon)) 
-                       (AST.KindConstraint <$> trfLoc trfKind' k)
+trfKindSig' :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.KindConstraint (Dom r) RangeStage)
+trfKindSig' k = annLocNoSema (combineSrcSpans (getLoc k) <$> (tokenBefore (srcSpanStart (getLoc k)) AnnDcolon)) 
+                             (AST.KindConstraint <$> trfLocNoSema trfKind' k)
 
-trfKind :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.Kind r)
-trfKind = trfLoc (trfKind' . cleanHsType)
+trfKind :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.Kind (Dom r) RangeStage)
+trfKind = trfLocNoSema (trfKind' . cleanHsType)
 
-trfKind' :: TransformName n r => HsKind n -> Trf (AST.Kind r)
+trfKind' ::TransformName n r => HsKind n -> Trf (AST.Kind (Dom r) RangeStage)
 trfKind' = trfKind'' . cleanHsType where
   trfKind'' (HsTyVar (rdrName . unLoc -> Exact n)) 
     | isWiredInName n && occNameString (nameOccName n) == "*"
@@ -48,12 +50,13 @@   trfKind'' (HsListTy kind) = AST.KindList <$> trfKind kind
   trfKind'' (HsAppsTy [unLoc -> HsAppPrefix t]) = trfKind' (unLoc t)
   trfKind'' (HsAppsTy [unLoc -> HsAppInfix n]) = AST.KindVar <$> trfName n
-  trfKind'' pt@(HsExplicitListTy {}) = AST.KindPromoted <$> annCont (trfPromoted' trfKind' pt) 
-  trfKind'' pt@(HsExplicitTupleTy {}) = AST.KindPromoted <$> annCont (trfPromoted' trfKind' pt) 
-  trfKind'' pt@(HsTyLit {}) = AST.KindPromoted <$> annCont (trfPromoted' trfKind' pt) 
+  trfKind'' pt@(HsExplicitListTy {}) = AST.KindPromoted <$> annContNoSema (trfPromoted' trfKind' pt) 
+  trfKind'' pt@(HsExplicitTupleTy {}) = AST.KindPromoted <$> annContNoSema (trfPromoted' trfKind' pt) 
+  trfKind'' pt@(HsTyLit {}) = AST.KindPromoted <$> annContNoSema (trfPromoted' trfKind' pt) 
   trfKind'' k = error ("Illegal kind: " ++ showSDocUnsafe (ppr k) ++ " (ctor: " ++ show (toConstr k) ++ ")")
 
-trfPromoted' :: TransformName n r => (HsType n -> Trf (a r)) -> HsType n -> Trf (AST.Promoted a r)
+trfPromoted' :: (TransformName n r, SemanticInfo (Dom r) a ~ NoSemanticInfo) 
+                  => (HsType n -> Trf (a (Dom r) RangeStage)) -> HsType n -> Trf (AST.Promoted a (Dom r) RangeStage)
 trfPromoted' f (HsTyLit (HsNumTy _ int)) = pure $ AST.PromotedInt int
 trfPromoted' f (HsTyLit (HsStrTy _ str)) = pure $ AST.PromotedString (unpackFS str)
 trfPromoted' f (HsTyVar name) = AST.PromotedCon <$> trfName name

@@ -13,9 +13,10 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
+import Language.Haskell.Tools.AST (Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfLiteral' :: HsLit -> Trf (AST.Literal a)
+trfLiteral' :: HsLit -> Trf (AST.Literal (Dom r) RangeStage)
 trfLiteral' (HsChar _ ch) = pure $ AST.CharLit ch
 trfLiteral' (HsCharPrim _ ch) = pure $ AST.PrimCharLit ch
 trfLiteral' (HsString _ str) = pure $ AST.StringLit (unpackFS str)
@@ -30,7 +31,7 @@ trfLiteral' (HsFloatPrim frac) = pure $ AST.PrimFloatLit (fl_value frac)
 trfLiteral' (HsDoublePrim frac) = pure $ AST.PrimDoubleLit (fl_value frac)
   
-trfOverloadedLit :: OverLitVal -> Trf (AST.Literal a)
+trfOverloadedLit :: OverLitVal -> Trf (AST.Literal (Dom r) RangeStage)
 trfOverloadedLit (HsIntegral _ i) = pure $ AST.IntLit i
 trfOverloadedLit (HsFractional frac) = pure $ AST.FracLit (fl_value frac)
 trfOverloadedLit (HsIsString _ str) = pure $ AST.StringLit (unpackFS str)

@@ -15,7 +15,7 @@ import Data.Data
 import Data.Generics.Uniplate.Operations
 import Data.Generics.Uniplate.Data
-import Data.StructuralTraversal
+import Control.Applicative
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.State
@@ -47,75 +47,55 @@ import DynFlags as GHC
 import Language.Haskell.TH.LanguageExtensions
 
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), RangeWithName, RangeWithType, RangeInfo
-                                  , SemanticInfo(..), semanticInfo, sourceInfo, semantics, annotation, nameInfo, nodeSpan)
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybe(..), AnnList(..), Dom, IdDom, RangeStage, NoSemanticInfo(..), NameInfo(..), CNameInfo(..), ScopeInfo(..), ImportInfo(..), ModuleInfo(..)
+                                  , semanticInfo, sourceInfo, semantics, annotation, nameInfo, nodeSpan, semaTraverse)
 import qualified Language.Haskell.Tools.AST as AST
 
 import Language.Haskell.Tools.AST.FromGHC.Base
 import Language.Haskell.Tools.AST.FromGHC.Decls
 import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
-
-addTypeInfos :: LHsBinds Id -> Ann AST.Module RangeWithName -> Ghc (Ann AST.Module RangeWithType)
-addTypeInfos bnds mod = traverseDown (return ()) (return ()) replaceNodeInfo mod
-  where replaceNodeInfo :: RangeWithName -> Ghc RangeWithType
-        replaceNodeInfo = semanticInfo !~ replaceSemanticInfo
-        replaceSemanticInfo NoSemanticInfo = return NoSemanticInfo
-        replaceSemanticInfo (ScopeInfo sc) = return $ ScopeInfo sc
-        replaceSemanticInfo (AmbiguousNameInfo sc d rdr l) = return $ NameInfo sc d (locMapping ! l)
-        replaceSemanticInfo (ModuleInfo mod imps) = ModuleInfo mod <$> mapM getType' imps
-        replaceSemanticInfo (NameInfo sc def ni) = NameInfo sc def <$> getType' ni
-        replaceSemanticInfo (ImportInfo mod access used) = ImportInfo mod <$> mapM getType' access <*> mapM getType' used
-        
-        getType' :: GHC.Name -> Ghc GHC.Id
-        getType' name = fromMaybe (error $ "Type of name '" ++ showSDocUnsafe (ppr name) ++ "' cannot be found") <$> getType name
-        getType name 
-          = lookupName name >>= \case
-              Just (AnId id) -> return (Just id)
-              Just (AConLike (RealDataCon dc)) -> return $ Just $ mkVanillaGlobal name (dataConUserType dc)
-              Just (AConLike (PatSynCon ps)) -> return $ Just $ mkVanillaGlobal name (createPatSynType ps)
-              Just (ATyCon tc) -> return $ Just $ mkVanillaGlobal name (tyConKind tc)
-              Nothing -> case Map.lookup name mapping of 
-                           Just id -> return (Just id)
-                           Nothing | isTyVarName name
-                                      -- unit type is for cases we don't know the kind
-                                   -> return $ Just $ mkVanillaGlobal name unitTy
-                           Nothing -> return Nothing
-        mapping = Map.fromList $ map (\id -> (getName id, id)) $ extractTypes bnds
-        locMapping = Map.fromList $ map (\(L l id) -> (l, id)) $ extractExprIds bnds
-        createPatSynType patSyn = case patSynSig patSyn of (_, _, _, _, args, res) -> mkFunTys args res
-
-getTypeVariables :: GHC.TyCon -> [Id]
-getTypeVariables tc
-  = tyConTyVars tc ++ maybe [] (\case (ClosedSynFamilyTyCon ax) -> maybe [] (concatMap cab_tvs . fromBranches . co_ax_branches) ax
-                                      _ -> []) (famTyConFlav_maybe tc)
+import Language.Haskell.Tools.AST.FromGHC.GHCUtils
 
-extractTypes :: LHsBinds Id -> [Id]
-extractTypes = concatMap universeBi . bagToList
+addTypeInfos :: LHsBinds Id -> Ann AST.Module (Dom GHC.Name) RangeStage -> Ghc (Ann AST.Module IdDom RangeStage)
+addTypeInfos bnds = semaTraverse 
+  (AST.SemaTrf
+    (\case (NameInfo sc def ni) -> CNameInfo sc def <$> getType' ni 
+           (AmbiguousNameInfo sc d rdr l) -> return $ CNameInfo sc d (locMapping ! l))
+    pure
+    (\(ImportInfo mod access used) -> ImportInfo mod <$> mapM getType' access <*> mapM getType' used)
+    (\(ModuleInfo mod imps) -> ModuleInfo mod <$> mapM getType' imps)
+    pure)
+  where locMapping = Map.fromList $ map (\(L l id) -> (l, id)) $ extractExprIds bnds
+        getType' name = fromMaybe (error $ "Type of name '" ++ showSDocUnsafe (ppr name) ++ "' cannot be found")
+                            <$> ((<|>) <$> getTopLevelId name <*> getLocalId bnds name)
 
 extractExprIds :: LHsBinds Id -> [Located Id]
         -- expressions like HsRecFld are removed from the typechecked representation, they are replaced by HsVar
 extractExprIds = catMaybes . map (\case (L l (HsVar (L _ n))) -> Just (L l n); _ -> Nothing) . concatMap universeBi . bagToList
 
+createModuleInfo :: Module -> Trf (AST.ModuleInfo GHC.Name)
+createModuleInfo mod = do prelude <- lift (xopt ImplicitPrelude . ms_hspp_opts <$> getModSummary (moduleName mod))
+                          (_,preludeImports) <- if prelude then getImportedNames "Prelude" Nothing else return (mod, [])
+                          return $ AST.ModuleInfo mod preludeImports
 
-trfModule :: Located (HsModule RdrName) -> Trf (Ann AST.Module RangeInfo)
-trfModule = trfLocCorrect (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) $ 
-  \(HsModule name exports imports decls deprec _) -> 
-    AST.Module <$> trfFilePragmas
-               <*> trfModuleHead name exports deprec
-               <*> trfImports imports
-               <*> trfDecls decls
+trfModule :: Module -> Located (HsModule RdrName) -> Trf (Ann AST.Module (Dom RdrName) RangeStage)
+trfModule mod = trfLocCorrect (createModuleInfo mod) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) $ 
+                  \(HsModule name exports imports decls deprec _) -> 
+                    AST.Module <$> trfFilePragmas
+                               <*> trfModuleHead name exports deprec
+                               <*> trfImports imports
+                               <*> trfDecls decls
        
-trfModuleRename :: Module -> Ann AST.Module RangeInfo -> (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString) -> Located (HsModule RdrName) -> Trf (Ann AST.Module RangeWithName)
-trfModuleRename mod rangeMod (gr,imports,exps,_) hsMod = do 
-  prelude <- lift (xopt ImplicitPrelude . ms_hspp_opts <$> getModSummary (moduleName mod))
-  (_,preludeImports) <- if prelude then getImportedNames "Prelude" Nothing else return (mod, [])
-  let addModuleInfo :: Module -> Ann AST.Module RangeWithName -> Trf (Ann AST.Module RangeWithName)
-      addModuleInfo m = AST.semantics != ModuleInfo m preludeImports
-  addModuleInfo mod =<< trfLocCorrect (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) (trfModuleRename' preludeImports) hsMod
-        
+trfModuleRename :: Module -> Ann AST.Module (Dom RdrName) RangeStage 
+                          -> (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString) 
+                          -> Located (HsModule RdrName) 
+                          -> Trf (Ann AST.Module (Dom GHC.Name) RangeStage)
+trfModuleRename mod rangeMod (gr,imports,exps,_) hsMod 
+    = do info <- createModuleInfo mod
+         trfLocCorrect (pure info) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) (trfModuleRename' (info ^. AST.implicitNames)) hsMod      
   where originalNames = Map.fromList $ catMaybes $ map getSourceAndInfo (rangeMod ^? biplateRef) 
-        getSourceAndInfo :: Ann AST.SimpleName RangeInfo -> Maybe (SrcSpan, RdrName)
+        getSourceAndInfo :: Ann AST.SimpleName (Dom RdrName) RangeStage -> Maybe (SrcSpan, RdrName)
         getSourceAndInfo n = (,) <$> (n ^? annotation&sourceInfo&nodeSpan) <*> (n ^? semantics&nameInfo)
         
         trfModuleRename' preludeImports hsMod@(HsModule name exports _ decls deprec _) = do
@@ -127,102 +107,102 @@                          <*> return transformedImports
                          <*> addToScope (concat @[] (transformedImports ^? AST.annList&semantics&AST.importedNames) ++ preludeImports) (trfDeclsGroup gr)
 
-trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> Maybe (Located [LIE n]) -> Maybe (Located WarningTxt) -> Trf (AnnMaybe AST.ModuleHead r) 
+trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> Maybe (Located [LIE n]) -> Maybe (Located WarningTxt) -> Trf (AnnMaybe AST.ModuleHead (Dom r) RangeStage) 
 trfModuleHead (Just mn) exports modPrag
-  = makeJust <$> (annLoc (tokensLoc [AnnModule, AnnWhere])
-                         (AST.ModuleHead <$> trfModuleName mn 
-                                         <*> trfExportList (srcSpanEnd $ getLoc mn) exports
-                                         <*> trfModulePragma modPrag))
+  = makeJust <$> (annLocNoSema (tokensLoc [AnnModule, AnnWhere])
+                               (AST.ModuleHead <$> trfModuleName mn 
+                                               <*> trfExportList (srcSpanEnd $ getLoc mn) exports
+                                               <*> trfModulePragma modPrag))
 trfModuleHead _ Nothing _ = nothing "" "" moduleHeadPos
   where moduleHeadPos = after AnnClose >>= \case loc@(RealSrcLoc _) -> return loc
                                                  _ -> atTheStart
 
-trfFilePragmas :: RangeAnnot a => Trf (AnnList AST.FilePragma a)
+trfFilePragmas :: Trf (AnnList AST.FilePragma (Dom r) RangeStage)
 trfFilePragmas = do pragmas <- asks pragmaComms
                     languagePragmas <- mapM trfLanguagePragma (fromMaybe [] $ (Map.lookup "LANGUAGE") pragmas)
                     optionsPragmas <- mapM trfOptionsPragma (fromMaybe [] $ (Map.lookup "OPTIONS_GHC") pragmas)
                     makeList "" atTheStart $ pure $ orderDefs $ languagePragmas ++ optionsPragmas
 
-trfLanguagePragma :: RangeAnnot a => Located String -> Trf (Ann AST.FilePragma a)
-trfLanguagePragma lstr@(L l str) = annLoc (pure l) (AST.LanguagePragma <$> makeList ", " (pure $ srcSpanStart $ getLoc $ last pragmaElems) 
-                                                                                         (mapM (trfLoc (pure . AST.LanguageExtension)) extensions))
+trfLanguagePragma :: Located String -> Trf (Ann AST.FilePragma (Dom r) RangeStage)
+trfLanguagePragma lstr@(L l str) = annLocNoSema (pure l) (AST.LanguagePragma <$> makeList ", " (pure $ srcSpanStart $ getLoc $ last pragmaElems) 
+                                                                                               (mapM (trfLocNoSema (pure . AST.LanguageExtension)) extensions))
   where pragmaElems = splitLocated lstr
         extensions = init $ drop 2 pragmaElems
 
-trfOptionsPragma :: RangeAnnot a => Located String -> Trf (Ann AST.FilePragma a)
-trfOptionsPragma (L l str) = annLoc (pure l) (AST.OptionsPragma <$> annCont (pure $ AST.StringNode str))
+trfOptionsPragma :: Located String -> Trf (Ann AST.FilePragma (Dom r) RangeStage)
+trfOptionsPragma (L l str) = annLocNoSema (pure l) (AST.OptionsPragma <$> annContNoSema (pure $ AST.StringNode str))
 
-trfModulePragma :: RangeAnnot a => Maybe (Located WarningTxt) -> Trf (AnnMaybe AST.ModulePragma a)
-trfModulePragma = trfMaybeDefault " " "" (trfLoc $ \case WarningTxt _ txts -> AST.ModuleWarningPragma <$> trfAnnList " " trfText' txts
-                                                         DeprecatedTxt _ txts -> AST.ModuleDeprecatedPragma <$> trfAnnList " " trfText' txts) 
+trfModulePragma :: Maybe (Located WarningTxt) -> Trf (AnnMaybe AST.ModulePragma (Dom r) RangeStage)
+trfModulePragma = trfMaybeDefault " " "" (trfLocNoSema $ \case WarningTxt _ txts -> AST.ModuleWarningPragma <$> trfAnnList " " trfText' txts
+                                                               DeprecatedTxt _ txts -> AST.ModuleDeprecatedPragma <$> trfAnnList " " trfText' txts) 
                                   (before AnnWhere)
 
-trfText' :: RangeAnnot a => StringLiteral -> Trf (AST.StringNode a)
+trfText' :: StringLiteral -> Trf (AST.StringNode (Dom r) RangeStage)
 trfText' = pure . AST.StringNode . unpackFS . sl_fs
 
 
 
-trfExportList :: TransformName n r => SrcLoc -> Maybe (Located [LIE n]) -> Trf (AnnMaybe AST.ExportSpecList r)
-trfExportList loc = trfMaybeDefault " " "" (trfLoc trfExportList') (pure loc)
+trfExportList :: TransformName n r => SrcLoc -> Maybe (Located [LIE n]) -> Trf (AnnMaybe AST.ExportSpecList (Dom r) RangeStage)
+trfExportList loc = trfMaybeDefault " " "" (trfLocNoSema trfExportList') (pure loc)
 
-trfExportList' :: TransformName n r => [LIE n] -> Trf (AST.ExportSpecList r)
+trfExportList' :: TransformName n r => [LIE n] -> Trf (AST.ExportSpecList (Dom r) RangeStage)
 trfExportList' exps = AST.ExportSpecList <$> (makeList ", " (after AnnOpenP) (orderDefs . catMaybes <$> (mapM trfExport exps)))
   
-trfExport :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.ExportSpec r))
-trfExport = trfMaybeLoc $ \case 
+trfExport :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.ExportSpec (Dom r) RangeStage))
+trfExport = trfMaybeLocNoSema $ \case 
   IEModuleContents n -> Just . AST.ModuleExport <$> (trfModuleName n)
   other -> do trf <- trfIESpec' other
-              fmap AST.DeclExport <$> (sequence $ fmap (annCont . return) trf)
+              fmap AST.DeclExport <$> (sequence $ fmap (annContNoSema . return) trf)
 
-trfImports :: TransformName n r => [LImportDecl n] -> Trf (AnnList AST.ImportDecl r)
+trfImports :: TransformName n r => [LImportDecl n] -> Trf (AnnList AST.ImportDecl (Dom r) RangeStage)
 trfImports (filter (not . ideclImplicit . unLoc) -> imps) 
   = AnnList <$> importDefaultLoc <*> mapM trfImport imps
-  where importDefaultLoc = toIndentedListAnnot (if Data.List.null imps then "\n" else "") "" "\n" . srcSpanEnd 
+  where importDefaultLoc = noSemaInfo . AST.ListPos (if Data.List.null imps then "\n" else "") "" "\n" True . srcSpanEnd 
                              <$> (combineSrcSpans <$> asks (srcLocSpan . srcSpanStart . contRange) 
                                                   <*> (srcLocSpan . srcSpanEnd <$> tokenLoc AnnWhere))
-trfImport :: forall n r . TransformName n r => LImportDecl n -> Trf (Ann AST.ImportDecl r)
-trfImport = (addImportData @r @n <=<) $ trfLoc $ \(GHC.ImportDecl src name pkg isSrc isSafe isQual isImpl declAs declHiding) ->
+trfImport :: TransformName n r => LImportDecl n -> Trf (Ann AST.ImportDecl (Dom r) RangeStage)
+trfImport (L l (GHC.ImportDecl src name pkg isSrc isSafe isQual isImpl declAs declHiding)) =
   let -- default positions of optional parts of an import declaration
       annBeforeQual = if isSrc then AnnClose else AnnImport
       annBeforeSafe = if isQual then AnnQualified else annBeforeQual
       annBeforePkg = if isSafe then AnnSafe else annBeforeSafe
       atAsPos = if isJust declHiding then before AnnOpenP else atTheEnd
-  in AST.ImportDecl 
-       <$> (if isSrc then makeJust <$> annLoc (tokensLoc [AnnOpen, AnnClose]) (pure AST.ImportSource)
+  in (\impdecl -> annLoc (createImportData =<< impdecl) (pure l) impdecl) $ AST.ImportDecl 
+       <$> (if isSrc then makeJust <$> annLocNoSema (tokensLoc [AnnOpen, AnnClose]) (pure AST.ImportSource)
                      else nothing " " "" (after AnnImport))
-       <*> (if isQual then makeJust <$> (annLoc (tokenLoc AnnQualified) (pure AST.ImportQualified)) 
+       <*> (if isQual then makeJust <$> (annLocNoSema (tokenLoc AnnQualified) (pure AST.ImportQualified)) 
                       else nothing " " "" (after annBeforeQual))
-       <*> (if isSafe then makeJust <$> (annLoc (tokenLoc AnnSafe) (pure AST.ImportSafe)) 
+       <*> (if isSafe then makeJust <$> (annLocNoSema (tokenLoc AnnSafe) (pure AST.ImportSafe)) 
                       else nothing " " "" (after annBeforeSafe))
        <*> maybe (nothing " " "" (after annBeforePkg)) 
-                 (\str -> makeJust <$> (annLoc (tokenLoc AnnPackageName) (pure (AST.StringNode (unpackFS $ sl_fs str))))) pkg
+                 (\str -> makeJust <$> (annLocNoSema (tokenLoc AnnPackageName) (pure (AST.StringNode (unpackFS $ sl_fs str))))) pkg
        <*> trfModuleName name 
        <*> maybe (nothing " " "" atAsPos) (\mn -> makeJust <$> (trfRenaming mn)) declAs
-       <*> trfImportSpecs declHiding
+       <*> trfImportSpecs declHiding 
   where trfRenaming mn
-          = annLoc (tokensLoc [AnnAs,AnnVal])
-                   (AST.ImportRenaming <$> (annLoc (tokenLoc AnnVal) 
-                                           (trfModuleName' mn)))  
+          = annLocNoSema (tokensLoc [AnnAs,AnnVal])
+                         (AST.ImportRenaming <$> (annLocNoSema (tokenLoc AnnVal) 
+                                                 (trfModuleName' mn)))  
   
-trfImportSpecs :: TransformName n r => Maybe (Bool, Located [LIE n]) -> Trf (AnnMaybe AST.ImportSpec r)
+trfImportSpecs :: TransformName n r => Maybe (Bool, Located [LIE n]) -> Trf (AnnMaybe AST.ImportSpec (Dom r) RangeStage)
 trfImportSpecs (Just (True, l)) 
-  = makeJust <$> trfLoc (\specs -> AST.ImportSpecHiding <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec specs))) l
+  = makeJust <$> trfLocNoSema (\specs -> AST.ImportSpecHiding <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec specs))) l
 trfImportSpecs (Just (False, l)) 
-  = makeJust <$> trfLoc (\specs -> AST.ImportSpecList <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec specs))) l
+  = makeJust <$> trfLocNoSema (\specs -> AST.ImportSpecList <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec specs))) l
 trfImportSpecs Nothing = nothing " " "" atTheEnd
     
-trfIESpec :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.IESpec r)) 
-trfIESpec = trfMaybeLoc trfIESpec'
+trfIESpec :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.IESpec (Dom r) RangeStage)) 
+trfIESpec = trfMaybeLocNoSema trfIESpec'
   
-trfIESpec' :: TransformName n r => IE n -> Trf (Maybe (AST.IESpec r))
+trfIESpec' :: TransformName n r => IE n -> Trf (Maybe (AST.IESpec (Dom r) RangeStage))
 trfIESpec' (IEVar n) = Just <$> (AST.IESpec <$> trfName n <*> (nothing "(" ")" atTheEnd))
 trfIESpec' (IEThingAbs n) = Just <$> (AST.IESpec <$> trfName n <*> (nothing "(" ")" atTheEnd))
 trfIESpec' (IEThingAll n) 
-  = Just <$> (AST.IESpec <$> trfName n <*> (makeJust <$> (annLoc (tokenLoc AnnDotdot) (pure AST.SubSpecAll))))
+  = Just <$> (AST.IESpec <$> trfName n <*> (makeJust <$> (annLocNoSema (tokenLoc AnnDotdot) (pure AST.SubSpecAll))))
 trfIESpec' (IEThingWith n _ ls _)
   = Just <$> (AST.IESpec <$> trfName n
                          <*> (makeJust <$> between AnnOpenP AnnCloseP 
-                                                  (annCont $ AST.SubSpecList <$> makeList ", " (after AnnOpenP) (mapM trfName ls))))
+                                                  (annContNoSema $ AST.SubSpecList <$> makeList ", " (after AnnOpenP) (mapM trfName ls))))
 trfIESpec' _ = pure Nothing
   
  

@@ -25,17 +25,17 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(..))
+import Language.Haskell.Tools.AST (Ann(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfPattern :: TransformName n r => Located (Pat n) -> Trf (Ann AST.Pattern r)
+trfPattern :: TransformName n r => Located (Pat n) -> Trf (Ann AST.Pattern (Dom r) RangeStage)
 -- field wildcards are not directly represented in GHC AST
 trfPattern (L l (ConPatIn name (RecCon (HsRecFields flds _)))) | any ((l ==) . getLoc) flds 
   = do let (fromWC, notWC) = partition ((l ==) . getLoc) flds
-       normalFields <- mapM (trfLoc trfPatternField') notWC
-       wildc <- annLoc (tokenLoc AnnDotdot) (pure AST.FieldWildcardPattern)
-       annLoc (pure l) (AST.RecPat <$> trfName name <*> makeNonemptyList ", " (pure (normalFields ++ [wildc])))
-trfPattern p | otherwise = trfLoc trfPattern' (correctPatternLoc p)
+       normalFields <- mapM (trfLocNoSema trfPatternField') notWC
+       wildc <- annLocNoSema (tokenLoc AnnDotdot) (pure AST.FieldWildcardPattern)
+       annLocNoSema (pure l) (AST.RecPat <$> trfName name <*> makeNonemptyList ", " (pure (normalFields ++ [wildc])))
+trfPattern p | otherwise = trfLocNoSema trfPattern' (correctPatternLoc p)
 
 -- | Locations for right-associative infix patterns are incorrect in GHC AST
 correctPatternLoc :: Located (Pat n) -> Located (Pat n)
@@ -43,7 +43,7 @@   = L (getLoc (correctPatternLoc left) `combineSrcSpans` getLoc (correctPatternLoc right)) p
 correctPatternLoc p = p
 
-trfPattern' :: TransformName n r => Pat n -> Trf (AST.Pattern r)
+trfPattern' :: TransformName n r => Pat n -> Trf (AST.Pattern (Dom r) RangeStage)
 trfPattern' (WildPat _) = pure AST.WildPat
 trfPattern' (VarPat name) = define $ AST.VarPat <$> trfName name
 trfPattern' (LazyPat pat) = AST.IrrPat <$> trfPattern pat
@@ -57,14 +57,14 @@ trfPattern' (ConPatIn name (RecCon (HsRecFields flds _))) = AST.RecPat <$> trfName name <*> trfAnnList ", " trfPatternField' flds
 trfPattern' (ConPatIn name (InfixCon left right)) = AST.InfixPat <$> trfPattern left <*> trfOperator name <*> trfPattern right
 trfPattern' (ViewPat expr pat _) = AST.ViewPat <$> trfExpr expr <*> trfPattern pat
-trfPattern' (SplicePat splice) = AST.SplicePat <$> annCont (trfSplice' splice)
-trfPattern' (LitPat lit) = AST.LitPat <$> annCont (trfLiteral' lit)
+trfPattern' (SplicePat splice) = AST.SplicePat <$> annContNoSema (trfSplice' splice)
+trfPattern' (LitPat lit) = AST.LitPat <$> annContNoSema (trfLiteral' lit)
 trfPattern' (SigPatIn pat (hswc_body . hsib_body -> typ)) = AST.TypeSigPat <$> trfPattern pat <*> trfType typ
-trfPattern' (NPat (ol_val . unLoc -> lit) _ _ _) = AST.LitPat <$> annCont (trfOverloadedLit lit)
-trfPattern' (NPlusKPat id (L l lit) _ _ _ _) = AST.NPlusKPat <$> define (trfName id) <*> annLoc (pure l) (trfOverloadedLit (ol_val lit))
+trfPattern' (NPat (ol_val . unLoc -> lit) _ _ _) = AST.LitPat <$> annContNoSema (trfOverloadedLit lit)
+trfPattern' (NPlusKPat id (L l lit) _ _ _ _) = AST.NPlusKPat <$> define (trfName id) <*> annLocNoSema (pure l) (trfOverloadedLit (ol_val lit))
 -- coercion pattern introduced by GHC
 trfPattern' (CoPat _ pat _) = trfPattern' pat
 
-trfPatternField' :: TransformName n r => HsRecField n (LPat n) -> Trf (AST.PatternField r)
+trfPatternField' :: TransformName n r => HsRecField n (LPat n) -> Trf (AST.PatternField (Dom r) RangeStage)
 trfPatternField' (HsRecField id arg False) = AST.NormalFieldPattern <$> trfName (getFieldOccName id) <*> trfPattern arg
 trfPatternField' (HsRecField id _ True) = AST.FieldPunPattern <$> trfName (getFieldOccName id)

@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase
            , ViewPatterns
+           , TypeFamilies
            #-}
 module Language.Haskell.Tools.AST.FromGHC.Stmts where
  
@@ -21,37 +22,36 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(..), AnnList(..), AnnMaybe(..))
+import Language.Haskell.Tools.AST (Ann(..), AnnList(..), AnnMaybe(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
  
-trfDoStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.Stmt r)
-trfDoStmt = trfLoc trfDoStmt'
+trfDoStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.Stmt (Dom r) RangeStage)
+trfDoStmt = trfLocNoSema trfDoStmt'
 
-trfDoStmt' :: TransformName n r => Stmt n (Located (HsExpr n)) -> Trf (AST.Stmt' AST.Expr r)
+trfDoStmt' :: TransformName n r => Stmt n (Located (HsExpr n)) -> Trf (AST.Stmt' AST.Expr (Dom r) RangeStage)
 trfDoStmt' = gTrfDoStmt' trfExpr
 
-gTrfDoStmt' :: TransformName n r => (Located (ge n) -> Trf (Ann ae r)) -> Stmt n (Located (ge n)) -> Trf (AST.Stmt' ae r)
+gTrfDoStmt' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Stmt n (Located (ge n)) -> Trf (AST.Stmt' ae (Dom r) RangeStage)
 gTrfDoStmt' et (BindStmt pat expr _ _ _) = AST.BindStmt <$> trfPattern pat <*> et expr
 gTrfDoStmt' et (BodyStmt expr _ _ _) = AST.ExprStmt <$> et expr
 gTrfDoStmt' et (LetStmt (unLoc -> binds)) = AST.LetStmt <$> addToScope binds (trfLocalBinds binds)
 gTrfDoStmt' et (LastStmt body _ _) = AST.ExprStmt <$> et body
 gTrfDoStmt' et (RecStmt { recS_stmts = stmts }) = AST.RecStmt <$> trfAnnList "," (gTrfDoStmt' et) stmts
 
-trfListCompStmts :: TransformName n r => [Located (Stmt n (LHsExpr n))] -> Trf (AnnList AST.ListCompBody r)
+trfListCompStmts :: TransformName n r => [Located (Stmt n (LHsExpr n))] -> Trf (AnnList AST.ListCompBody (Dom r) RangeStage)
 trfListCompStmts [unLoc -> ParStmt blocks _ _ _, unLoc -> (LastStmt {})]
   = nonemptyAnnList
       <$> trfScopedSequence (\(ParStmtBlock stmts _ _) -> 
-                                let ann = toNodeAnnot $ collectLocs $ getNormalStmts stmts
-                                 in Ann ann . AST.ListCompBody . AnnList ann . concat 
-                                      <$> trfScopedSequence trfListCompStmt stmts
+                                let ann = collectLocs $ getNormalStmts stmts
+                                 in annLocNoSema (pure ann) (AST.ListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt stmts))
                             ) blocks
 trfListCompStmts others 
   = let ann = (collectLocs $ getNormalStmts others)
-     in AnnList (toNodeAnnot ann) . (:[]) 
-          <$> annLoc (pure ann)
-                     (AST.ListCompBody . AnnList (toNodeAnnot ann) . concat <$> trfScopedSequence trfListCompStmt others) 
+     in makeList "|" (pure $ srcSpanStart ann)
+          ((:[]) <$> annLocNoSema (pure ann)
+                                  (AST.ListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt others)))
 
-trfListCompStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf [Ann AST.CompStmt r]
+trfListCompStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf [Ann AST.CompStmt (Dom r) RangeStage]
 trfListCompStmt (L l trst@(TransStmt { trS_stmts = stmts })) 
   = (++) <$> (concat <$> local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanEnd (getLoc (last stmts))) }) (trfScopedSequence trfListCompStmt stmts)) 
          <*> ((:[]) <$> extractActualStmt trst)
@@ -59,15 +59,15 @@ trfListCompStmt (unLoc -> LastStmt _ _ _) = pure []
 trfListCompStmt other = (:[]) <$> copyAnnot AST.CompStmt (trfDoStmt other)
   
-extractActualStmt :: TransformName n r => Stmt n (LHsExpr n) -> Trf (Ann AST.CompStmt r)
+extractActualStmt :: TransformName n r => Stmt n (LHsExpr n) -> Trf (Ann AST.CompStmt (Dom r) RangeStage)
 extractActualStmt = \case
   TransStmt { trS_form = ThenForm, trS_using = using, trS_by = by } 
     -> addAnnotation by using (AST.ThenStmt <$> trfExpr using <*> trfMaybe "," "" trfExpr by)
   TransStmt { trS_form = GroupForm, trS_using = using, trS_by = by } 
     -> addAnnotation by using (AST.GroupStmt <$> trfMaybe "," "" trfExpr by <*> (makeJust <$> trfExpr using))
   where addAnnotation by using
-          = annLoc (combineSrcSpans (getLoc using) . combineSrcSpans (maybe noSrcSpan getLoc by)
-                      <$> tokenLocBack AnnThen)
+          = annLocNoSema (combineSrcSpans (getLoc using) . combineSrcSpans (maybe noSrcSpan getLoc by)
+                            <$> tokenLocBack AnnThen)
   
 getNormalStmts :: [Located (Stmt n (LHsExpr n))] -> [Located (Stmt n (LHsExpr n))]
 getNormalStmts (L _ (LastStmt body _ _) : rest) = getNormalStmts rest

@@ -18,24 +18,26 @@ import Language.Haskell.Tools.AST.FromGHC.Base
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
 
+import Language.Haskell.Tools.AST (Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.QuasiQuote r)
+trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.QuasiQuote (Dom r) RangeStage)
  -- the lexer does not provide us with tokens '[', '|' and '|]'
 trfQuasiQuotation' (HsQuasiQuote id _ l str) 
-  = AST.QuasiQuote <$> annLoc (pure quoterLoc) (trfName' id)
-                   <*> annLoc (pure strLoc) (pure $ AST.QQString (unpackFS str))
+  = AST.QuasiQuote <$> annLocNoSema (pure quoterLoc) (trfName' id)
+                   <*> annLocNoSema (pure strLoc) (pure $ AST.QQString (unpackFS str))
   where quoterLoc = mkSrcSpan (updateCol (subtract (1 + length (occNameString $ rdrNameOcc $ rdrName id))) (srcSpanStart l)) 
                               (updateCol (subtract 1) (srcSpanStart l))
         strLoc = mkSrcSpan (srcSpanStart l) (updateCol (subtract 2) (srcSpanEnd l))
 
 
-trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.Splice r)
+trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.Splice (Dom r) RangeStage)
 trfSplice' (HsTypedSplice _ expr) = AST.ParenSplice <$> trfExpr expr
-trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.Bracket r)
+
+trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.Bracket (Dom r) RangeStage)
 trfBracket' (ExpBr expr) = AST.ExprBracket <$> trfExpr expr
 trfBracket' (TExpBr expr) = AST.ExprBracket <$> trfExpr expr
-trfBracket' (VarBr _ expr) = AST.ExprBracket <$> annCont (AST.Var <$> (annCont (trfName' expr)))
+trfBracket' (VarBr _ expr) = AST.ExprBracket <$> annCont createScopeInfo (AST.Var <$> (annContNoSema (trfName' expr)))
 trfBracket' (PatBr pat) = AST.PatternBracket <$> trfPattern pat
 trfBracket' (DecBrL decls) = AST.DeclsBracket <$> trfDecls decls
 trfBracket' (DecBrG decls) = AST.DeclsBracket <$> trfDeclsGroup decls

@@ -7,9 +7,9 @@ import Language.Haskell.Tools.AST.FromGHC.Monad
 import Language.Haskell.Tools.AST.FromGHC.Utils
 import Language.Haskell.Tools.AST.FromGHC.Base
-import Language.Haskell.Tools.AST (Ann(..))
+import Language.Haskell.Tools.AST (Ann(..), Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
-trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.QuasiQuote r)
-trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.Splice r)
-trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.Bracket r)
+trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.QuasiQuote (Dom r) RangeStage)
+trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.Splice (Dom r) RangeStage)
+trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.Bracket (Dom r) RangeStage)

@@ -33,10 +33,10 @@ 
 import Debug.Trace
 
-trfType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.Type r)
-trfType = trfLoc trfType'
+trfType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.Type (Dom r) RangeStage)
+trfType = trfLocNoSema trfType'
 
-trfType' :: TransformName n r => HsType n -> Trf (AST.Type r)
+trfType' :: TransformName n r => HsType n -> Trf (AST.Type (Dom r) RangeStage)
 trfType' = trfType'' . cleanHsType where
   trfType'' (HsForAllTy [] typ) = trfType' (unLoc typ)
   trfType'' (HsForAllTy bndrs typ) = AST.TyForall <$> defineTypeVars (trfBindings bndrs) 
@@ -45,7 +45,7 @@                                            <*> trfType typ
   trfType'' (HsTyVar name) = AST.TyVar <$> transformingPossibleVar name (trfName name)
   trfType'' (HsAppsTy apps) | Just (head, args) <- getAppsTyHead_maybe apps 
-    = foldl (\core t -> AST.TyApp <$> annLoc (pure $ getLoc head `combineSrcSpans` getLoc t) core <*> trfType t) (trfType' (unLoc head)) args
+    = foldl (\core t -> AST.TyApp <$> annLocNoSema (pure $ getLoc head `combineSrcSpans` getLoc t) core <*> trfType t) (trfType' (unLoc head)) args
   trfType'' (HsAppTy t1 t2) = AST.TyApp <$> trfType t1 <*> trfType t2
   trfType'' (HsFunTy t1 t2) = AST.TyFun <$> trfType t1 <*> trfType t2
   trfType'' (HsListTy typ) = AST.TyList <$> trfType typ
@@ -61,46 +61,46 @@   trfType'' (HsBangTy (HsSrcBang _ SrcNoUnpack _) typ) = AST.TyNoUnpack <$> trfType typ
   trfType'' (HsBangTy (HsSrcBang _ _ SrcStrict) typ) = AST.TyBang <$> trfType typ
   trfType'' (HsBangTy (HsSrcBang _ _ SrcLazy) typ) = AST.TyLazy <$> trfType typ
-  trfType'' pt@(HsExplicitListTy {}) = AST.TyPromoted <$> annCont (trfPromoted' trfType' pt) 
-  trfType'' pt@(HsExplicitTupleTy {}) = AST.TyPromoted <$> annCont (trfPromoted' trfType' pt) 
-  trfType'' pt@(HsTyLit {}) = AST.TyPromoted <$> annCont (trfPromoted' trfType' pt) 
+  trfType'' pt@(HsExplicitListTy {}) = AST.TyPromoted <$> annContNoSema (trfPromoted' trfType' pt) 
+  trfType'' pt@(HsExplicitTupleTy {}) = AST.TyPromoted <$> annContNoSema (trfPromoted' trfType' pt) 
+  trfType'' pt@(HsTyLit {}) = AST.TyPromoted <$> annContNoSema (trfPromoted' trfType' pt) 
   trfType'' (HsWildCardTy _) = pure AST.TyWildcard -- TODO: named wildcards
   trfType'' t = error ("Illegal type: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
   
-trfBindings :: TransformName n r => [Located (HsTyVarBndr n)] -> Trf (AnnList AST.TyVar r)
+trfBindings :: TransformName n r => [Located (HsTyVarBndr n)] -> Trf (AnnList AST.TyVar (Dom r) RangeStage)
 trfBindings vars = trfAnnList "\n" trfTyVar' vars
   
-trfTyVar :: TransformName n r => Located (HsTyVarBndr n) -> Trf (Ann AST.TyVar r)
-trfTyVar = trfLoc trfTyVar' 
+trfTyVar :: TransformName n r => Located (HsTyVarBndr n) -> Trf (Ann AST.TyVar (Dom r) RangeStage)
+trfTyVar = trfLocNoSema trfTyVar' 
   
-trfTyVar' :: TransformName n r => HsTyVarBndr n -> Trf (AST.TyVar r)
+trfTyVar' :: TransformName n r => HsTyVarBndr n -> Trf (AST.TyVar (Dom r) RangeStage)
 trfTyVar' (UserTyVar name) = AST.TyVarDecl <$> typeVarTransform (trfName name)
                                            <*> (nothing " " "" atTheEnd)
 trfTyVar' (KindedTyVar name kind) = AST.TyVarDecl <$> typeVarTransform (trfName name) 
                                                   <*> trfKindSig (Just kind)
   
-trfCtx :: TransformName n r => Trf SrcLoc -> Located (HsContext n) -> Trf (AnnMaybe AST.Context r)
+trfCtx :: TransformName n r => Trf SrcLoc -> Located (HsContext n) -> Trf (AnnMaybe AST.Context (Dom r) RangeStage)
 trfCtx sp (L l []) = nothing " " "" sp
 trfCtx _ (L l [L _ (HsParTy t)]) 
-  = makeJust <$> annLoc (combineSrcSpans l <$> tokenLoc AnnDarrow) 
-                        (AST.ContextMulti <$> trfAnnList ", " trfAssertion' [t])
+  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow) 
+                              (AST.ContextMulti <$> trfAnnList ", " trfAssertion' [t])
 trfCtx _ (L l [t]) 
-  = makeJust <$> annLoc (combineSrcSpans l <$> tokenLoc AnnDarrow) 
-                        (AST.ContextOne <$> trfAssertion t)
-trfCtx _ (L l ctx) = makeJust <$> annLoc (combineSrcSpans l <$> tokenLoc AnnDarrow) 
-                                         (AST.ContextMulti <$> trfAnnList ", " trfAssertion' ctx) 
+  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow) 
+                              (AST.ContextOne <$> trfAssertion t)
+trfCtx _ (L l ctx) = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow) 
+                                               (AST.ContextMulti <$> trfAnnList ", " trfAssertion' ctx) 
   
-trfAssertion :: TransformName n r => LHsType n -> Trf (Ann AST.Assertion r)
-trfAssertion = trfLoc trfAssertion'
+trfAssertion :: TransformName n r => LHsType n -> Trf (Ann AST.Assertion (Dom r) RangeStage)
+trfAssertion = trfLocNoSema trfAssertion'
 
-trfAssertion' :: forall n r . TransformName n r => HsType n -> Trf (AST.Assertion r)
+trfAssertion' :: forall n r . TransformName n r => HsType n -> Trf (AST.Assertion (Dom r) RangeStage)
 trfAssertion' (cleanHsType -> HsParTy t) 
   = trfAssertion' (unLoc t)
 trfAssertion' (cleanHsType -> HsOpTy left op right) 
   = AST.InfixAssert <$> trfType left <*> trfOperator op <*> trfType right
 trfAssertion' (cleanHsType -> t) = case cleanHsType base of
    HsTyVar name -> AST.ClassAssert <$> trfName name <*> trfAnnList " " trfType' args
-   HsEqTy t1 t2 -> AST.InfixAssert <$> trfType t1 <*> annLoc (tokenLoc AnnTilde) (trfOperator' typeEq) <*> trfType t2
+   HsEqTy t1 t2 -> AST.InfixAssert <$> trfType t1 <*> annLocNoSema (tokenLoc AnnTilde) (trfOperator' typeEq) <*> trfType t2
    t -> error ("Illegal trf assertion: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
   where (args, sp, base) = getArgs t
         getArgs :: HsType n -> ([LHsType n], Maybe SrcSpan, HsType n)

@@ -6,6 +6,8 @@            , MultiParamTypeClasses
            , FlexibleContexts
            , AllowAmbiguousTypes
+           , TypeApplications
+           , TypeFamilies
            #-}
 module Language.Haskell.Tools.AST.FromGHC.Utils where
 
@@ -33,51 +35,34 @@ import Language.Haskell.Tools.AST.FromGHC.SourceMap
 import Debug.Trace
 
--- | Annotations that is made up from ranges
-class HasRange annot => RangeAnnot annot where
-  toNodeAnnot :: SrcSpan -> annot
-  toListAnnot :: String -> String -> String -> SrcLoc -> annot
-  toIndentedListAnnot :: String -> String -> String -> SrcLoc -> annot
-  toOptAnnot :: String -> String -> SrcLoc -> annot
+-- | Creates a semantic information for a name
+createNameInfo :: n -> Trf (NameInfo n)
+createNameInfo name = do locals <- asks localsInScope
+                         isDefining <- asks defining
+                         return (NameInfo locals isDefining name)
 
-instance RangeAnnot (NodeInfo (SemanticInfo n) SpanInfo) where
-  toNodeAnnot = NodeInfo NoSemanticInfo . NodeSpan
-  toListAnnot bef aft sep = NodeInfo NoSemanticInfo . ListPos bef aft sep False
-  toIndentedListAnnot bef aft sep = NodeInfo NoSemanticInfo . ListPos bef aft sep True
-  toOptAnnot bef aft = NodeInfo NoSemanticInfo . OptionalPos bef aft
 
--- | Annotations that carry semantic information
-class SemanticAnnot annot n where
-  addSemanticInfo :: SemanticInfo n -> annot -> annot
-  addScopeData :: annot -> Trf annot
-  addImportData :: Ann AST.ImportDecl annot -> Trf (Ann AST.ImportDecl annot)
-  
-instance SemanticAnnot RangeWithName GHC.Name where
-  addSemanticInfo si = semanticInfo .= si
-  addScopeData = semanticInfo !~ (\case NoSemanticInfo -> do locals <- asks localsInScope
-                                                             return $ ScopeInfo locals
-                                        inf -> return inf)
-  addImportData = addImportData'
+-- | Creates a semantic information for an ambiguous name (caused by field disambiguation for example)
+createAmbigousNameInfo :: RdrName -> SrcSpan -> Trf (NameInfo n)
+createAmbigousNameInfo name span = do locals <- asks localsInScope
+                                      isDefining <- asks defining
+                                      return (AmbiguousNameInfo locals isDefining name span)
 
-instance {-# OVERLAPPING #-} SemanticAnnot RangeInfo RdrName where
-  addSemanticInfo si = semanticInfo .= si
-  addScopeData = semanticInfo !~ (\case NoSemanticInfo -> do locals <- asks localsInScope
-                                                             return $ ScopeInfo locals
-                                        inf -> return inf)
-  addImportData = pure
+-- | Creates a semantic information for an implicit name
+createImplicitNameInfo :: String -> Trf (NameInfo n)
+createImplicitNameInfo name = do locals <- asks localsInScope
+                                 isDefining <- asks defining
+                                 return (ImplicitNameInfo locals isDefining name)
 
-instance {-# OVERLAPPABLE #-} SemanticAnnot RangeInfo n where
-  addSemanticInfo si = id
-  addScopeData = pure
-  addImportData = pure
-  
 -- | Adds semantic information to an impord declaration. See ImportInfo.
-addImportData' :: Ann AST.ImportDecl RangeWithName -> Trf (Ann AST.ImportDecl RangeWithName)
-addImportData' imp = 
-  do (mod,importedNames) <- getImportedNames (nameString $ imp ^. element&importModule&element)
-                                             (imp ^? element&importPkg&annJust&element&stringNodeStr)
-     names <- lift $ filterM (checkImportVisible (imp ^. element)) importedNames
-     return $ annotation .- addSemanticInfo (ImportInfo mod importedNames names) $ imp
+createImportData :: (HsHasName n, GHCName n) => AST.ImportDecl (Dom n) stage -> Trf (ImportInfo n)
+createImportData imp = 
+  do (mod,importedNames) <- getImportedNames (imp ^. importModule&element&AST.moduleNameString)
+                                             (imp ^? importPkg&annJust&element&stringNodeStr)
+     names <- lift $ filterM (checkImportVisible imp) importedNames
+     lookedUpNames <- lift $ mapM (getFromNameUsing getTopLevelId) names
+     lookedUpImported <- lift $ mapM (getFromNameUsing getTopLevelId) importedNames
+     return $ ImportInfo mod (catMaybes lookedUpImported) (catMaybes lookedUpNames)
 
 -- | Get names that are imported from a given import
 getImportedNames :: String -> Maybe String -> Trf (GHC.Module, [GHC.Name])
@@ -92,108 +77,120 @@   return (mod, ifaceNames ++ loadedNames)
 
 -- | Check is a given name is imported from an import with given import specification.
-checkImportVisible :: GhcMonad m => AST.ImportDecl RangeWithName -> GHC.Name -> m Bool
+checkImportVisible :: (HsHasName n, GhcMonad m) => AST.ImportDecl (Dom n) stage -> GHC.Name -> m Bool
 checkImportVisible imp name
   | importIsExact imp 
-  = or <$> mapM (`ieSpecMatches` name) (imp ^? importExacts :: [IESpec RangeWithName])
+  = or @[] <$> mapM (`ieSpecMatches` name) (imp ^? importExacts)
   | importIsHiding imp 
-  = not . or <$> mapM (`ieSpecMatches` name) (imp ^? importHidings :: [IESpec RangeWithName])
+  = not . or  @[] <$> mapM (`ieSpecMatches` name) (imp ^? importHidings)
   | otherwise = return True
 
-ieSpecMatches :: GhcMonad m => AST.IESpec RangeWithName -> GHC.Name -> m Bool
-ieSpecMatches (AST.IESpec ((^? element&simpleName&annotation&semanticInfo&nameInfo) -> Just n) ss) name
+ieSpecMatches :: (HsHasName n, GhcMonad m) => AST.IESpec (Dom n) stage -> GHC.Name -> m Bool
+ieSpecMatches (AST.IESpec (hsGetNames <=< (^? element&simpleName&semantics&nameInfo) -> [n]) ss) name
   | n == name = return True
   | isTyConName n
   = (\case Just (ATyCon tc) -> name `elem` map getName (tyConDataCons tc)) 
              <$> lookupName n
-  | otherwise = return False
+ieSpecMatches _ _ = return False
 
+noSemaInfo :: src -> NodeInfo NoSemanticInfo src
+noSemaInfo = NodeInfo NoSemanticInfo
 
 -- | Creates a place for a missing node with a default location
-nothing :: RangeAnnot a => String -> String -> Trf SrcLoc -> Trf (AnnMaybe e a)
-nothing bef aft pos = annNothing . toOptAnnot bef aft <$> pos 
+nothing :: String -> String -> Trf SrcLoc -> Trf (AnnMaybe e (Dom n) RangeStage)
+nothing bef aft pos = annNothing . noSemaInfo . OptionalPos bef aft <$> pos 
 
-emptyList :: RangeAnnot a => String -> Trf SrcLoc -> Trf (AnnList e a)
-emptyList sep ann = AnnList <$> (toListAnnot "" "" sep <$> ann) <*> pure []
+emptyList :: String -> Trf SrcLoc -> Trf (AnnList e (Dom n) RangeStage)
+emptyList sep ann = AnnList <$> (noSemaInfo . ListPos "" "" sep False <$> ann) <*> pure []
 
 -- | Creates a place for a list of nodes with a default place if the list is empty.
-makeList :: RangeAnnot a => String -> Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
-makeList sep ann ls = AnnList <$> (toListAnnot "" "" sep <$> ann) <*> ls
+makeList :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
+makeList sep ann ls = AnnList <$> (noSemaInfo . ListPos "" "" sep False <$> ann) <*> ls
 
-makeListBefore :: RangeAnnot a => String -> String -> Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
+makeListBefore :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
 makeListBefore bef sep ann ls = do isEmpty <- null <$> ls 
-                                   AnnList <$> (toListAnnot (if isEmpty then bef else "") "" sep <$> ann) <*> ls
+                                   AnnList <$> (noSemaInfo . ListPos (if isEmpty then bef else "") "" sep False <$> ann) <*> ls
 
-makeListAfter :: RangeAnnot a => String -> String -> Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
+makeListAfter :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
 makeListAfter aft sep ann ls = do isEmpty <- null <$> ls 
-                                  AnnList <$> (toListAnnot "" (if isEmpty then aft else "") sep <$> ann) <*> ls
+                                  AnnList <$> (noSemaInfo . ListPos "" (if isEmpty then aft else "") sep False <$> ann) <*> ls
 
-makeNonemptyList :: RangeAnnot a => String -> Trf [Ann e a] -> Trf (AnnList e a)
-makeNonemptyList sep ls = AnnList (toListAnnot "" "" sep noSrcLoc) <$> ls
+makeNonemptyList :: String -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
+makeNonemptyList sep ls = AnnList (noSemaInfo $ ListPos "" "" sep False noSrcLoc) <$> ls
 
 -- | Creates a place for an indented list of nodes with a default place if the list is empty.
-makeIndentedList :: RangeAnnot a => Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
-makeIndentedList ann ls = AnnList <$> (toIndentedListAnnot "" "" "\n" <$> ann) <*> ls
+makeIndentedList :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
+makeIndentedList ann ls = AnnList <$> (noSemaInfo . ListPos  "" "" "\n" True <$> ann) <*> ls
 
-makeIndentedListNewlineBefore :: RangeAnnot a => Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
+makeIndentedListNewlineBefore :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
 makeIndentedListNewlineBefore ann ls = do isEmpty <- null <$> ls 
-                                          AnnList <$> (toIndentedListAnnot (if isEmpty then "\n" else "") "" "\n" <$> ann) <*> ls
+                                          AnnList <$> (noSemaInfo . ListPos (if isEmpty then "\n" else "") "" "\n" True <$> ann) <*> ls
 
-makeIndentedListBefore :: RangeAnnot a => String -> Trf SrcLoc -> Trf [Ann e a] -> Trf (AnnList e a)
+makeIndentedListBefore :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
 makeIndentedListBefore bef sp ls = do isEmpty <- null <$> ls 
-                                      AnnList <$> (toIndentedListAnnot (if isEmpty then bef else "") "" "\n" <$> sp) <*> ls
+                                      AnnList <$> (noSemaInfo . ListPos (if isEmpty then bef else "") "" "\n" True <$> sp) <*> ls
   
-makeNonemptyIndentedList :: RangeAnnot a => Trf [Ann e a] -> Trf (AnnList e a)
-makeNonemptyIndentedList ls = AnnList (toIndentedListAnnot "" "" "\n" noSrcLoc) <$> ls
+makeNonemptyIndentedList :: Trf [Ann e (Dom n) RangeStage] -> Trf (AnnList e (Dom n) RangeStage)
+makeNonemptyIndentedList ls = AnnList (noSemaInfo $ ListPos "" "" "\n" True noSrcLoc) <$> ls
   
 -- | Transform a located part of the AST by automatically transforming the location.
 -- Sets the source range for transforming children.
-trfLoc :: RangeAnnot i => (a -> Trf (b i)) -> Located a -> Trf (Ann b i)
-trfLoc = trfLocCorrect pure
+trfLoc :: (a -> Trf (b (Dom n) RangeStage)) -> Trf (SemanticInfo (Dom n) b) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLoc f sema = trfLocCorrect sema pure f
 
+trfLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLocNoSema f = trfLoc f (pure NoSemanticInfo)
+
 -- | Transforms a possibly-missing node with the default location of the end of the focus.
-trfMaybe :: RangeAnnot i => String -> String -> (Located a -> Trf (Ann e i)) -> Maybe (Located a) -> Trf (AnnMaybe e i)
+trfMaybe :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Maybe (Located a) -> Trf (AnnMaybe e (Dom n) RangeStage)
 trfMaybe bef aft f = trfMaybeDefault bef aft f atTheEnd
 
 -- | Transforms a possibly-missing node with a default location
-trfMaybeDefault :: RangeAnnot i => String -> String -> (Located a -> Trf (Ann e i)) -> Trf SrcLoc -> Maybe (Located a) -> Trf (AnnMaybe e i)
+trfMaybeDefault :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Trf SrcLoc -> Maybe (Located a) -> Trf (AnnMaybe e (Dom n) RangeStage)
 trfMaybeDefault _   _   f _   (Just e) = makeJust <$> f e
 trfMaybeDefault bef aft _ loc Nothing  = nothing bef aft loc
 
 -- | Transform a located part of the AST by automatically transforming the location
 -- with correction by applying the given function. Sets the source range for transforming children.
-trfLocCorrect :: RangeAnnot i => (SrcSpan -> Trf SrcSpan) -> (a -> Trf (b i)) -> Located a -> Trf (Ann b i)
-trfLocCorrect locF f (L l e) = annLoc (locF l) (f e)
+trfLocCorrect :: Trf (SemanticInfo (Dom n) b) -> (SrcSpan -> Trf SrcSpan) -> (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLocCorrect sema locF f (L l e) = annLoc sema (locF l) (f e)
 
 -- | Transform a located part of the AST by automatically transforming the location.
 -- Sets the source range for transforming children.
-trfMaybeLoc :: RangeAnnot i => (a -> Trf (Maybe (b i))) -> Located a -> Trf (Maybe (Ann b i))
-trfMaybeLoc f (L l e) = do fmap (Ann (toNodeAnnot l)) <$> local (\s -> s { contRange = l }) (f e)
+trfMaybeLoc :: (a -> Trf (Maybe (b (Dom n) RangeStage))) -> SemanticInfo (Dom n) b -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
+trfMaybeLoc f sema (L l e) = do fmap (Ann (NodeInfo sema (NodeSpan l))) <$> local (\s -> s { contRange = l }) (f e)
 
+trfMaybeLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (Maybe (b (Dom n) RangeStage))) -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
+trfMaybeLocNoSema f = trfMaybeLoc f NoSemanticInfo
+
 -- | Creates a place for a list of nodes with the default place at the end of the focus if the list is empty.
-trfAnnList :: RangeAnnot i => String -> (a -> Trf (b i)) -> [Located a] -> Trf (AnnList b i)
+trfAnnList ::SemanticInfo (Dom n) b ~ NoSemanticInfo =>  String -> (a -> Trf (b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnList b (Dom n) RangeStage)
 trfAnnList sep _ [] = makeList sep atTheEnd (pure [])
-trfAnnList sep f ls = makeList sep (pure $ noSrcLoc) (mapM (trfLoc f) ls)
+trfAnnList sep f ls = makeList sep (pure $ noSrcLoc) (mapM (trfLoc f (pure NoSemanticInfo)) ls)
 
-trfAnnList' :: RangeAnnot i => String -> (Located a -> Trf (Ann b i)) -> [Located a] -> Trf (AnnList b i)
+trfAnnList' :: String -> (Located a -> Trf (Ann b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnList b (Dom n) RangeStage)
 trfAnnList' sep _ [] = makeList sep atTheEnd (pure [])
 trfAnnList' sep f ls = makeList sep (pure $ noSrcLoc) (mapM f ls)
 
 
 -- | Creates a place for a list of nodes that cannot be empty.
-nonemptyAnnList :: RangeAnnot i => [Ann e i] -> AnnList e i
-nonemptyAnnList = AnnList (toListAnnot "" "" "" noSrcLoc)
+nonemptyAnnList :: [Ann e (Dom n) RangeStage] -> AnnList e (Dom n) RangeStage
+nonemptyAnnList = AnnList (noSemaInfo $ ListPos "" "" "" False noSrcLoc)
 
 -- | Creates an optional node from an existing element
-makeJust :: RangeAnnot a => Ann e a -> AnnMaybe e a
-makeJust e = AnnMaybe (toOptAnnot "" "" noSrcLoc) (Just e)
+makeJust :: Ann e (Dom n) RangeStage -> AnnMaybe e (Dom n) RangeStage
+makeJust e = AnnMaybe (noSemaInfo $ OptionalPos "" "" noSrcLoc) (Just e)
 
 -- | Annotates a node with the given location and focuses on the given source span.
-annLoc :: RangeAnnot a => Trf SrcSpan -> Trf (b a) -> Trf (Ann b a)
-annLoc locm nodem = do loc <- locm
-                       node <- focusOn loc nodem
-                       return (Ann (toNodeAnnot loc) node)
+annLoc :: Trf (SemanticInfo (Dom n) b) -> Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
+annLoc semam locm nodem = do loc <- locm
+                             node <- focusOn loc nodem
+                             sema <- semam
+                             return (Ann (NodeInfo sema (NodeSpan loc)) node)
 
+annLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
+annLocNoSema = annLoc (pure NoSemanticInfo)
+
 -- * Focus manipulation
 
 focusOn :: SrcSpan -> Trf a -> Trf a
@@ -248,8 +245,8 @@ after tok = srcSpanEnd <$> tokenLoc tok
 
 -- | The element should span from the given token to the end of focus
-annFrom :: RangeAnnot a => AnnKeywordId -> Trf (e a) -> Trf (Ann e a)
-annFrom kw = annLoc (combineSrcSpans <$> tokenLoc kw <*> asks (srcLocSpan . srcSpanEnd . contRange))
+annFrom :: AnnKeywordId -> Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annFrom kw sema = annLoc sema (combineSrcSpans <$> tokenLoc kw <*> asks (srcLocSpan . srcSpanEnd . contRange))
 
 -- | Gets the position at the beginning of the focus       
 atTheStart :: Trf SrcLoc
@@ -289,11 +286,15 @@ uniqueTokenAnywhere keyw = fromMaybe noSrcSpan <$> (getKeywordAnywhere keyw <$> asks srcMap)
         
 -- | Annotates the given element with the current focus as a location.
-annCont :: RangeAnnot a => Trf (e a) -> Trf (Ann e a)
-annCont = annLoc (asks contRange)
+annCont :: Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annCont sema = annLoc sema (asks contRange)
 
+annContNoSema :: SemanticInfo (Dom n) e ~ NoSemanticInfo => Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annContNoSema = annCont (pure NoSemanticInfo)
+
 -- | Annotates the element with the same annotation that is on the other element
-copyAnnot :: (Ann a i -> b i) -> Trf (Ann a i) -> Trf (Ann b i)
+copyAnnot :: SemanticInfo (Dom n) a ~ SemanticInfo (Dom n) b 
+               => (Ann a (Dom n) RangeStage -> b (Dom n) RangeStage) -> Trf (Ann a (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
 copyAnnot f at = (\(Ann i a) -> Ann i (f (Ann i a))) <$> at
 
 -- | Combine source spans into one that contains them all
@@ -315,11 +316,11 @@ collectLocs = foldLocs . map getLoc
 
 -- | Rearrange definitions to appear in the order they are defined in the source file.
-orderDefs :: RangeAnnot i => [Ann e i] -> [Ann e i]
-orderDefs = sortBy (compare `on` AST.ordSrcSpan . getRange . _annotation)
+orderDefs :: [Ann e (Dom n) RangeStage] -> [Ann e (Dom n) RangeStage]
+orderDefs = sortBy (compare `on` AST.ordSrcSpan . (^. AST.annotation & AST.sourceInfo & AST.nodeSpan))
 
 -- | Orders a list of elements to the order they are defined in the source file.
-orderAnnList :: RangeAnnot i => AnnList e i -> AnnList e i
+orderAnnList :: AnnList e (Dom n) RangeStage -> AnnList e (Dom n) RangeStage
 orderAnnList (AnnList a ls) = AnnList a (orderDefs ls)
 
 

@@ -1,5 +1,5 @@ name:                haskell-tools-ast-fromghc
-version:             0.1.2.0
+version:             0.1.3.0
 synopsis:            Creating the Haskell-Tools AST from GHC's representations
 description:         This package collects information from various representations of a Haskell program in GHC 
 homepage:            https://github.com/nboldi/haskell-tools
@@ -29,16 +29,15 @@                      , Language.Haskell.Tools.AST.FromGHC.Utils
                      , Language.Haskell.Tools.AST.FromGHC.SourceMap
 
-  build-depends:       base              >=4.9 && <5.0
-                     , ghc               >=8.0 && <8.1
-                     , haskell-tools-ast >=0.1 && <0.2
+  build-depends:       base              >=4.9   && <5.0
+                     , ghc               >=8.0   && <8.1
+                     , haskell-tools-ast >=0.1.3 && <0.2
                      , references        >=0.3.2 && <1.0
-                     , bytestring        >=0.10 && <1.0
-                     , safe              >=0.3
-                     , uniplate          >=1.6  && <2.0
-                     , containers        >=0.5 && <0.6
-                     , mtl               >=2.2 && <2.3
-                     , split             >=0.2 && <0.3
-                     , structural-traversal >=0.1 && <0.2
-                     , template-haskell  >=2.11 && <3.0
+                     , bytestring        >=0.10  && <1.0
+                     , safe              >=0.3   && <1.0
+                     , uniplate          >=1.6   && <2.0
+                     , containers        >=0.5   && <0.6
+                     , mtl               >=2.2   && <2.3
+                     , split             >=0.2   && <0.3
+                     , template-haskell  >=2.11  && <3.0
   default-language:    Haskell2010