store and propagate the exact source location for all judgements in the grammar. It may not be used accurately in the error messages yet

19 files changed, 323 insertions, 310 deletions

diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index f6d346320..a862f85e2 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -210,8 +210,7 @@ generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
 generateModuleCode opts file minfo = do
   let minfo1 = subexpModule minfo
       minfo2 = case minfo1 of
-                 (m,mi) -> (m,mi{jments=Map.filter (\x -> case x of {AnyInd _ _ -> False; _ -> True}) (jments mi)
-                                , positions=Map.empty})
+                 (m,mi) -> (m,mi{jments=Map.filter (\x -> case x of {AnyInd _ _ -> False; _ -> True}) (jments mi)})
   putPointE Normal opts ("  wrote file" +++ file) $ ioeIO $ encodeFile file minfo2
   return minfo1
 
diff --git a/src/compiler/GF/Compile/Abstract/TypeCheck.hs b/src/compiler/GF/Compile/Abstract/TypeCheck.hs
index 2632c54dd..bddc6f0c0 100644
--- a/src/compiler/GF/Compile/Abstract/TypeCheck.hs
+++ b/src/compiler/GF/Compile/Abstract/TypeCheck.hs
@@ -72,9 +72,9 @@ checkContext st = checkTyp st . cont2exp
 checkTyp :: SourceGrammar -> Type -> [Message]
 checkTyp gr typ = err (\x -> [text x]) ppConstrs $ justTypeCheck gr typ vType
 
-checkDef :: SourceGrammar -> Fun -> Type -> [Equation] -> [Message]
+checkDef :: SourceGrammar -> Fun -> Type -> [L Equation] -> [Message]
 checkDef gr (m,fun) typ eqs = err (\x -> [text x]) ppConstrs $ do
-  bcs <- mapM (\b -> checkBranch (grammar2theory gr) (initTCEnv []) b (type2val typ)) eqs
+  bcs <- mapM (\(L _ b) -> checkBranch (grammar2theory gr) (initTCEnv []) b (type2val typ)) eqs
   let (bs,css) = unzip bcs
   (constrs,_) <- unifyVal (concat css)
   return $ filter notJustMeta constrs
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 84ecdde0a..a61192500 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -94,7 +94,8 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
   where
    checkAbs js i@(c,info) =
      case info of
-       AbsFun (Just ty) _ _ -> do let mb_def = do
+       AbsFun (Just (L loc ty)) _ _ 
+                            -> do let mb_def = do
                                         let (cxt,(_,i),_) = typeForm ty
                                         info <- lookupIdent i js
                                         info <- case info of
@@ -102,8 +103,8 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
                                                                      return info
                                                   _            -> return info
                                         case info of
-                                          CncCat (Just (RecType [])) _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
-                                          _                              -> Bad "no def lin"
+                                          CncCat (Just (L loc (RecType []))) _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
+                                          _                                      -> Bad "no def lin"
                                              
                                   case lookupIdent c js of
                                     Ok (AnyInd _ _) -> return js
@@ -111,14 +112,14 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
                                                   return $ updateTree (c,CncFun ty (Just def) pn) js
                                     Ok (CncFun ty Nothing    pn) ->
                                       case mb_def of
-                                        Ok def -> return $ updateTree (c,CncFun ty (Just def) pn) js
+                                        Ok def -> return $ updateTree (c,CncFun ty (Just (L (0,0) def)) pn) js
                                         Bad _  -> do checkWarn $ text "no linearization of" <+> ppIdent c
                                                      return js
                                     _ -> do
                                       case mb_def of
                                         Ok def -> do (cont,val) <- linTypeOfType gr cm ty
                                                      let linty = (snd (valCat ty),cont,val)
-                                                     return $ updateTree (c,CncFun (Just linty) (Just def) Nothing) js
+                                                     return $ updateTree (c,CncFun (Just linty) (Just (L (0,0) def)) Nothing) js
                                         Bad _  -> do checkWarn $ text "no linearization of" <+> ppIdent c
                                                      return js
        AbsCat (Just _) -> case lookupIdent c js of
@@ -127,17 +128,17 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
          Ok (CncCat _ mt mp) -> do
            checkWarn $ 
              text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}"
-           return $ updateTree (c,CncCat (Just defLinType) mt mp) js
+           return $ updateTree (c,CncCat (Just (L (0,0) defLinType)) mt mp) js
          _ -> do
            checkWarn $ 
              text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}"
-           return $ updateTree (c,CncCat (Just defLinType) Nothing Nothing) js
+           return $ updateTree (c,CncCat (Just (L (0,0) defLinType)) Nothing Nothing) js
        _ -> return js
      
    checkCnc js i@(c,info) =
      case info of
        CncFun _ d pn -> case lookupOrigInfo gr am c of
-                          Ok (_,AbsFun (Just ty) _ _) -> 
+                          Ok (_,AbsFun (Just (L _ ty)) _ _) -> 
                                      do (cont,val) <- linTypeOfType gr cm ty
                                         let linty = (snd (valCat ty),cont,val)
                                         return $ updateTree (c,CncFun (Just linty) d pn) js
@@ -156,50 +157,51 @@ checkInfo :: [SourceModule] -> SourceModule -> Ident -> Info -> Check Info
 checkInfo ms (m,mo) c info = do
   checkReservedId c
   case info of
-    AbsCat (Just cont) -> mkCheck "category" $ 
-      checkContext gr cont
+    AbsCat (Just (L loc cont)) -> 
+      mkCheck loc "category" $ 
+        checkContext gr cont
 
-    AbsFun (Just typ0) ma md -> do
+    AbsFun (Just (L loc typ0)) ma md -> do
       typ <- compAbsTyp [] typ0   -- to calculate let definitions
-      mkCheck "type of function" $
+      mkCheck loc "type of function" $
         checkTyp gr typ
       case md of
-        Just eqs -> mkCheck "definition of function" $
+        Just eqs -> mkCheck loc "definition of function" $
 	                  checkDef gr (m,c) typ eqs
         Nothing  -> return info
-      return (AbsFun (Just typ) ma md)
+      return (AbsFun (Just (L loc typ)) ma md)
 
-    CncFun linty@(Just (cat,cont,val)) (Just trm) mpr -> chIn "linearization of" $ do
+    CncFun linty@(Just (cat,cont,val)) (Just (L loc trm)) mpr -> chIn loc "linearization of" $ do
       (trm',_) <- checkLType gr [] trm (mkFunType (map (\(_,_,ty) -> ty) cont) val)  -- erases arg vars
       mpr <- checkPrintname gr mpr
-      return (CncFun linty (Just trm') mpr)
+      return (CncFun linty (Just (L loc trm')) mpr)
 
-    CncCat (Just typ) mdef mpr -> chIn "linearization type of" $ do
+    CncCat (Just (L loc typ)) mdef mpr -> chIn loc "linearization type of" $ do
       (typ,_) <- checkLType gr [] typ typeType
       typ  <- computeLType gr [] typ
       mdef <- case mdef of
-        Just def -> do
+        Just (L loc def) -> do
           (def,_) <- checkLType gr [] def (mkFunType [typeStr] typ)
-          return $ Just def
+          return $ Just (L loc def)
         _ -> return mdef
       mpr <- checkPrintname gr mpr
-      return (CncCat (Just typ) mdef mpr)
+      return (CncCat (Just (L loc typ)) mdef mpr)
 
-    ResOper pty pde -> chIn "operation" $ do
+    ResOper pty pde -> chIn (0,0) "operation" $ do
       (pty', pde') <- case (pty,pde) of
-         (Just ty, Just de) -> do
+         (Just (L loc1 ty), Just (L loc2 de)) -> do
            ty'     <- checkLType gr [] ty typeType >>= computeLType gr [] . fst
            (de',_) <- checkLType gr [] de ty'
-           return (Just ty', Just de')
-         (_      , Just de) -> do
+           return (Just (L loc1 ty'), Just (L loc2 de'))
+         (_      , Just (L loc de)) -> do
            (de',ty') <- inferLType gr [] de
-           return (Just ty', Just de')
+           return (Just (L loc ty'), Just (L loc de'))
          (_      , Nothing) -> do
            checkError (text "No definition given to the operation")
       return (ResOper pty' pde')
 
-    ResOverload os tysts -> chIn "overloading" $ do
-      tysts' <- mapM (uncurry $ flip (checkLType gr [])) tysts  -- return explicit ones
+    ResOverload os tysts -> chIn (0,0) "overloading" $ do
+      tysts' <- mapM (uncurry $ flip (\(L loc1 t) (L loc2 ty) -> checkLType gr [] t ty >>= \(t,ty) -> return (L loc1 t, L loc2 ty))) tysts  -- return explicit ones
       tysts0 <- checkErr $ lookupOverload gr m c  -- check against inherited ones too
       tysts1 <- mapM (uncurry $ flip (checkLType gr [])) 
                   [(mkFunType args val,tr) | (args,(val,tr)) <- tysts0]
@@ -209,16 +211,16 @@ checkInfo ms (m,mo) c info = do
         sort [let (xs,t) = typeFormCnc x in t : map (\(b,x,t) -> t) xs | (_,x) <- tysts1]
       return (ResOverload os [(y,x) | (x,y) <- tysts'])
 
-    ResParam (Just pcs) _ -> chIn "parameter type" $ do
+    ResParam (Just pcs) _ -> chIn (0,0) "parameter type" $ do
       ts <- checkErr $ liftM concat $ mapM mkPar pcs
       return (ResParam (Just pcs) (Just ts))
 
     _ ->  return info
  where
    gr = MGrammar ((m,mo) : ms)
-   chIn cat = checkIn (text "Happened in" <+> text cat <+> ppIdent c <+> ppPosition mo c <> colon)
+   chIn loc cat = checkIn (text "Happened in" <+> text cat <+> ppIdent c <+> ppPosition m loc <> colon)
 
-   mkPar (f,co) = do
+   mkPar (L _ (f,co)) = do
      vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
      return $ map (mkApp (QC m f)) vs
 
@@ -229,9 +231,9 @@ checkInfo ms (m,mo) c info = do
       | otherwise -> checkUniq $ y:xs
      _ -> return ()
 
-   mkCheck cat ss = case ss of
+   mkCheck loc cat ss = case ss of
      [] -> return info
-     _  -> checkError (vcat ss $$ text "in" <+> text cat <+> ppIdent c <+> ppPosition mo c)
+     _  -> checkError (vcat ss $$ text "in" <+> text cat <+> ppIdent c <+> ppPosition m loc)
 
    compAbsTyp g t = case t of
      Vr x -> maybe (checkError (text "no value given to variable" <+> ppIdent x)) return $ lookup x g
@@ -246,10 +248,10 @@ checkInfo ms (m,mo) c info = do
      _ -> composOp (compAbsTyp g) t  
 
 
-checkPrintname :: SourceGrammar -> Maybe Term -> Check (Maybe Term)
-checkPrintname gr (Just t) = do (t,_) <- checkLType gr [] t typeStr
-                                return (Just t)
-checkPrintname gr Nothing  = return Nothing
+checkPrintname :: SourceGrammar -> Maybe (L Term) -> Check (Maybe (L Term))
+checkPrintname gr (Just (L loc t)) = do (t,_) <- checkLType gr [] t typeStr
+                                        return (Just (L loc t))
+checkPrintname gr Nothing          = return Nothing
 
 -- | for grammars obtained otherwise than by parsing ---- update!!
 checkReservedId :: Ident -> Check ()
diff --git a/src/compiler/GF/Compile/Coding.hs b/src/compiler/GF/Compile/Coding.hs
index 49538bd35..b909aac7d 100644
--- a/src/compiler/GF/Compile/Coding.hs
+++ b/src/compiler/GF/Compile/Coding.hs
@@ -25,13 +25,15 @@ codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)
       CncFun mty pt mpr   -> CncFun mty (fmap (codeTerm co) pt) (fmap (codeTerm co) mpr)
       _ -> info
 
-codeTerm :: (String -> String) -> Term -> Term
-codeTerm co t = case t of
+codeTerm :: (String -> String) -> L Term -> L Term
+codeTerm co (L loc t) = L loc (codt t)
+  where
+    codt t = case t of
       K s -> K (co s)
-      T ty cs -> T ty [(codp p,codeTerm co v) | (p,v) <- cs]
+      T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
       EPatt p -> EPatt (codp p)
-      _ -> composSafeOp (codeTerm co) t
-  where
+      _ -> composSafeOp codt t
+
     codp p = case p of  --- really: composOpPatt
       PR rs -> PR [(l,codp p) | (l,p) <- rs]
       PString s -> PString (co s)
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 3db308f68..cb447f536 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -60,7 +60,7 @@ canon2pgf opts pars cgr@(M.MGrammar ((a,abm):cms)) = do
   gflags = Map.empty
   aflags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (M.flags abm)]
 
-  mkDef (Just eqs) = Just [C.Equ ps' (mkExp scope' e) | (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
+  mkDef (Just eqs) = Just [C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
   mkDef Nothing    = Nothing
 
   mkArrity (Just a) = a
@@ -68,10 +68,10 @@ canon2pgf opts pars cgr@(M.MGrammar ((a,abm):cms)) = do
 
   -- concretes
   lfuns = [(f', (mkType [] ty, mkArrity ma, mkDef pty)) | 
-             (f,AbsFun (Just ty) ma pty) <- tree2list (M.jments abm), let f' = i2i f]
+             (f,AbsFun (Just (L _ ty)) ma pty) <- tree2list (M.jments abm), let f' = i2i f]
   funs = Map.fromAscList lfuns
   lcats = [(i2i c, snd (mkContext [] cont)) |
-                (c,AbsCat (Just cont)) <- tree2list (M.jments abm)]
+                (c,AbsCat (Just (L _ cont))) <- tree2list (M.jments abm)]
   cats = Map.fromAscList lcats
   catfuns = Map.fromList 
     [(cat,[f | (f, (C.DTyp _ c _,_,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
@@ -91,16 +91,16 @@ canon2pgf opts pars cgr@(M.MGrammar ((a,abm):cms)) = do
                 ---- then (trace "decode" D.convertStringsInTerm decodeUTF8) else id
       umkTerm = utf . mkTerm
       lins    = Map.fromAscList 
-        [(f', umkTerm tr)  | (f,CncFun _ (Just tr) _) <- js, 
+        [(f', umkTerm tr)  | (f,CncFun _ (Just (L _ tr)) _) <- js, 
             let f' = i2i f, exists f'] -- eliminating lins without fun 
             -- needed even here because of restricted inheritance
       lincats = Map.fromAscList 
-        [(i2i c, mkCType ty) | (c,CncCat (Just ty) _ _) <- js]
+        [(i2i c, mkCType ty) | (c,CncCat (Just (L _ ty)) _ _) <- js]
       lindefs = Map.fromAscList 
-        [(i2i c, umkTerm tr)  | (c,CncCat _ (Just tr) _) <- js]
+        [(i2i c, umkTerm tr)  | (c,CncCat _ (Just (L _ tr)) _) <- js]
       printnames = Map.union 
-        (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncFun _ _ (Just tr)) <- js])
-        (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncCat _ _ (Just tr)) <- js])
+        (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncFun _ _ (Just (L _ tr))) <- js])
+        (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncCat _ _ (Just (L _ tr))) <- js])
       params = Map.fromAscList 
         [(i2i c, pars lang0 c) | (c,CncCat (Just ty) _ _) <- js]
       fcfg = Nothing
@@ -236,16 +236,15 @@ mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do
 
 reorder :: Ident -> SourceGrammar -> SourceGrammar
 reorder abs cg = M.MGrammar $ 
-    (abs, M.ModInfo M.MTAbstract M.MSComplete aflags [] Nothing [] [] adefs poss):
-      [(c, M.ModInfo (M.MTConcrete abs) M.MSComplete fs [] Nothing [] [] (sorted2tree js) poss)
+    (abs, M.ModInfo M.MTAbstract M.MSComplete aflags [] Nothing [] [] adefs):
+      [(c, M.ModInfo (M.MTConcrete abs) M.MSComplete fs [] Nothing [] [] (sorted2tree js))
             | (c,(fs,js)) <- cncs] 
      where
-       poss = emptyBinTree -- positions no longer needed
        mos = M.modules cg
        adefs = sorted2tree $ sortIds $
                  predefADefs ++ Look.allOrigInfos cg abs
        predefADefs = 
-         [(c, AbsCat (Just [])) | c <- [cFloat,cInt,cString]]
+         [(c, AbsCat (Just (L (0,0) []))) | c <- [cFloat,cInt,cString]]
        aflags = 
          concatOptions [M.flags mo | (_,mo) <- M.modules cg, M.isModAbs mo]
 
@@ -259,7 +258,7 @@ reorder abs cg = M.MGrammar $
                      Just r <- [lookup i (M.allExtendSpecs cg la)]]
 
          predefCDefs = 
-           [(c, CncCat (Just GM.defLinType) Nothing Nothing) | c <- [cInt,cFloat,cString]]
+           [(c, CncCat (Just (L (0,0) GM.defLinType)) Nothing Nothing) | c <- [cInt,cFloat,cString]]
 
        sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
 
@@ -292,8 +291,8 @@ canon2canon opts abs cg0 =
   j2j cg (f,j) = 
     let debug = if verbAtLeast opts Verbose then trace ("+ " ++ showIdent f) else id in
     case j of
-      CncFun x (Just tr) z -> CncFun x (Just (debug (t2t (unfactor cg0 tr)))) z
-      CncCat (Just ty) (Just x) y -> CncCat (Just (ty2ty ty)) (Just (t2t (unfactor cg0 x))) y
+      CncFun x (Just (L loc tr)) z -> CncFun x (Just (L loc (debug (t2t (unfactor cg0 tr))))) z
+      CncCat (Just (L locty ty)) (Just (L locx x)) y -> CncCat (Just (L locty (ty2ty ty))) (Just (L locx (t2t (unfactor cg0 x)))) y
       _ -> j
    where
       cg1 = cg
@@ -315,7 +314,7 @@ canon2canon opts abs cg0 =
     -- flatten record arguments of param constructors
   p2p (f,j) = case j of
       ResParam (Just ps) (Just vs) -> 
-        ResParam (Just [(c,concatMap unRec cont) | (c,cont) <- ps]) (Just (map unrec vs))
+        ResParam (Just [L loc (c,concatMap unRec cont) | L loc (c,cont) <- ps]) (Just (map unrec vs))
       _ -> j
   unRec (bt,x,ty) = case ty of
       RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (Explicit,identW,typ)] 
@@ -359,13 +358,13 @@ paramValues cgr = (labels,untyps,typs) where
   partyps = nub $ 
             --- [App (Q (IC "Predef") (IC "Ints")) (EInt i) | i <- [1,9]] ---linTypeInt 
             [ty | 
-              (_,(_,CncCat (Just ty0) _ _)) <- jments,
+              (_,(_,CncCat (Just (L _ ty0)) _ _)) <- jments,
               ty  <- typsFrom ty0
             ] ++ [
              Q m ty | 
               (m,(ty,ResParam _ _)) <- jments
             ] ++ [ty | 
-              (_,(_,CncFun _ (Just tr) _)) <- jments,
+              (_,(_,CncFun _ (Just (L _ tr)) _)) <- jments,
               ty  <- err (const []) snd $ appSTM (typsFromTrm tr) []
             ]
   params = [(ty, errVal (traceD ("UNKNOWN PARAM TYPE" +++ show ty) []) $ 
@@ -407,7 +406,7 @@ paramValues cgr = (labels,untyps,typs) where
     [(cat,[f | let RecType fs = GM.defLinType, f <- fs]) | cat <- [cInt,cFloat, cString]] ++
     reverse ---- TODO: really those lincats that are reached
             ---- reverse is enough to expel overshadowed ones... 
-      [(cat,ls) | (_,(cat,CncCat (Just ty) _ _)) <- jments, 
+      [(cat,ls) | (_,(cat,CncCat (Just (L _ ty)) _ _)) <- jments, 
                   RecType ls <- [unlockTy ty]]
   labels = Map.fromList $ concat 
     [((cat,[lab]),(typ,i)): 
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index 2c556b36f..a9e182f7f 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -64,24 +64,24 @@ evalInfo opts ms m c info = do
 
   CncCat ptyp pde ppr -> do
     pde' <- case (ptyp,pde) of
-      (Just typ, Just de) -> do
+      (Just (L _ typ), Just (L loc de)) -> do
         de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
-        return (Just (factor param c 0 de))
-      (Just typ, Nothing) -> do
+        return (Just (L loc (factor param c 0 de)))
+      (Just (L loc typ), Nothing) -> do
         de <- mkLinDefault gr typ
         de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
-        return (Just (factor param c 0 de))
+        return (Just (L loc (factor param c 0 de)))
       _ -> return pde   -- indirection
 
-    ppr' <- liftM Just $ evalPrintname gr c ppr (Just $ K $ showIdent c)
+    ppr' <- liftM Just $ evalPrintname gr c ppr (Just (L (0,0) (K $ showIdent c)))
 
     return (CncCat ptyp pde' ppr')
 
   CncFun (mt@(Just (_,cont,val))) pde ppr -> --trace (prt c) $
        eIn (text "linearization in type" <+> ppTerm Unqualified 0 (mkProd cont val []) $$ text "of function") $ do
     pde' <- case pde of
-      Just de -> do de <- partEval opts gr (cont,val) de
-                    return (Just (factor param c 0 de))
+      Just (L loc de) -> do de <- partEval opts gr (cont,val) de
+                            return (Just (L loc (factor param c 0 de)))
       Nothing -> return pde
     ppr' <-  liftM Just $ evalPrintname gr c ppr pde'
     return $ CncFun mt pde' ppr' -- only cat in type actually needed
@@ -89,8 +89,8 @@ evalInfo opts ms m c info = do
   ResOper pty pde 
     | OptExpand `Set.member` optim -> do
          pde' <- case pde of
-                   Just de -> do de <- computeConcrete gr de
-                                 return (Just (factor param c 0 de))
+                   Just (L loc de) -> do de <- computeConcrete gr de
+                                         return (Just (L loc (factor param c 0 de)))
                    Nothing -> return Nothing
          return $ ResOper pty pde'
 
@@ -161,13 +161,14 @@ mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
 -- lin for functions, cat name for cats (dispatch made in evalCncDef above).
 --- We cannot use linearization at this stage, since we do not know the
 --- defaults we would need for question marks - and we're not yet in canon.
-evalPrintname :: SourceGrammar -> Ident -> Maybe Term -> Maybe Term -> Err Term
+evalPrintname :: SourceGrammar -> Ident -> Maybe (L Term) -> Maybe (L Term) -> Err (L Term)
 evalPrintname gr c ppr lin =
   case ppr of
-    Just pr -> comp pr
+    Just (L loc pr) -> do pr <- comp pr
+                          return (L loc pr)
     Nothing -> case lin of
-                 Just t  -> return $ K $ clean $ render (ppTerm Unqualified 0 (oneBranch t))
-                 Nothing -> return $ K $ showIdent c ----
+                 Just (L loc t)  -> return $ L loc (K $ clean $ render (ppTerm Unqualified 0 (oneBranch t)))
+                 Nothing -> return $ L (0,0) (K $ showIdent c) ----
  where
    comp = computeConcrete gr
 
diff --git a/src/compiler/GF/Compile/Refresh.hs b/src/compiler/GF/Compile/Refresh.hs
index 04800fcce..1ecc99788 100644
--- a/src/compiler/GF/Compile/Refresh.hs
+++ b/src/compiler/GF/Compile/Refresh.hs
@@ -116,18 +116,18 @@ refreshModule (k,ms) mi@(i,mo)
   | otherwise = return (k, mi:ms)
  where
   refreshRes (k,cs) ci@(c,info) = case info of
-    ResOper ptyp (Just trm) -> do   ---- refresh ptyp
+    ResOper ptyp (Just (L loc trm)) -> do   ---- refresh ptyp
       (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, ResOper ptyp (Just trm')):cs)
+      return $ (k', (c, ResOper ptyp (Just (L loc trm'))):cs)
     ResOverload os tyts -> do
       (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ 
-                    appSTM (mapPairsM refresh tyts) (initIdStateN k)
+                    appSTM (mapPairsM (\(L loc t) -> liftM (L loc) (refresh t)) tyts) (initIdStateN k)
       return $ (k', (c, ResOverload os tyts'):cs)
-    CncCat mt (Just trm) pn -> do   ---- refresh mt, pn
+    CncCat mt (Just (L loc trm)) pn -> do   ---- refresh mt, pn
       (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, CncCat mt (Just trm') pn):cs)
-    CncFun mt (Just trm) pn -> do   ---- refresh pn
+      return $ (k', (c, CncCat mt (Just (L loc trm')) pn):cs)
+    CncFun mt (Just (L loc trm)) pn -> do   ---- refresh pn
       (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, CncFun mt (Just trm') pn):cs)
+      return $ (k', (c, CncFun mt (Just (L loc trm')) pn):cs)
     _ -> return (k, ci:cs)
 
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 59a8c6a3d..f7ca8fb28 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -54,7 +54,7 @@ renameModule :: [SourceModule] -> SourceModule -> Check SourceModule
 renameModule ms (name,mo) = checkIn (text "renaming module" <+> ppIdent name) $ do
   let js1 = jments mo
   status <- buildStatus (MGrammar ms) name mo
-  js2    <- checkMap (renameInfo mo status) js1
+  js2    <- checkMap (renameInfo status name) js1
   return (name, mo {opens = map forceQualif (opens mo), jments = js2})
 
 type Status = (StatusTree, [(OpenSpec, StatusTree)])
@@ -137,31 +137,49 @@ forceQualif o = case o of
   OSimple i   -> OQualif i i
   OQualif _ i -> OQualif i i
   
-renameInfo :: SourceModInfo -> Status -> Ident -> Info -> Check Info
-renameInfo mo status i info = checkIn 
-    (text "renaming definition of" <+> ppIdent i <+> ppPosition mo i) $ 
-                                case info of
-  AbsCat pco -> liftM AbsCat (renPerh (renameContext status) pco)
-  AbsFun  pty pa ptr -> liftM3 AbsFun (ren pty) (return pa) (renPerh (mapM (renameEquation status [])) ptr)
-  ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
-  ResOverload os tysts -> 
-    liftM (ResOverload os) (mapM (pairM rent) tysts)
-
-  ResParam (Just pp) m -> do
-    pp' <- mapM (renameParam status) pp
-    return (ResParam (Just pp') m)
-  ResValue t -> do
-    t <- rent t
-    return (ResValue t)
-  CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
-  CncFun mt  ptr ppr -> liftM2 (CncFun mt)      (ren ptr) (ren ppr)
-  _ -> return info
- where 
-   ren = renPerh rent
-   rent = renameTerm status []
-
-renPerh ren (Just t) = liftM Just $ ren t
-renPerh ren Nothing  = return Nothing
+renameInfo :: Status -> Ident -> Ident -> Info -> Check Info
+renameInfo status m i info =
+  case info of
+    AbsCat pco -> liftM AbsCat (renPerh (renameContext status) pco)
+    AbsFun  pty pa ptr -> liftM3 AbsFun (renTerm pty) (return pa) (renMaybe (mapM (renLoc (renEquation status))) ptr)
+    ResOper pty ptr -> liftM2 ResOper (renTerm pty) (renTerm ptr)
+    ResOverload os tysts -> liftM (ResOverload os) (mapM (renPair (renameTerm status [])) tysts)
+    ResParam (Just pp) m -> do
+      pp' <- mapM (renLoc (renParam status)) pp
+      return (ResParam (Just pp') m)
+    ResValue t -> do
+      t <- renLoc (renameTerm status []) t
+      return (ResValue t)
+    CncCat pty ptr ppr -> liftM3 CncCat (renTerm pty) (renTerm ptr) (renTerm ppr)
+    CncFun mt  ptr ppr -> liftM2 (CncFun mt)          (renTerm ptr) (renTerm ppr)
+    _ -> return info
+  where
+    renTerm = renPerh (renameTerm status [])
+
+    renPerh ren = renMaybe (renLoc ren)
+
+    renMaybe ren (Just x) = ren x >>= return . Just
+    renMaybe ren Nothing  = return Nothing
+
+    renLoc ren (L loc x) =
+      checkIn (text "renaming of" <+> ppIdent i <+> ppPosition m loc) $ do
+        x <- ren x
+        return (L loc x)
+
+    renPair ren (L locx x, L locy y) = do x <- ren x
+                                          y <- ren y
+                                          return (L locx x, L locy y)
+
+    renEquation :: Status -> Equation -> Check Equation
+    renEquation b (ps,t) = do
+        (ps',vs) <- liftM unzip $ mapM (renamePattern b) ps
+        t'       <- renameTerm b (concat vs) t
+        return (ps',t')
+
+    renParam :: Status -> Param -> Check Param
+    renParam env (c,co) = do
+      co' <- renameContext env co
+      return (c,co')
 
 renameTerm :: Status -> [Ident] -> Term -> Check Term
 renameTerm env vars = ren vars where
@@ -283,11 +301,6 @@ renamePattern env patt = case patt of
    renp  = renamePattern env
    renid = renameIdentTerm env
 
-renameParam :: Status -> (Ident, Context) -> Check (Ident, Context)
-renameParam env (c,co) = do
-  co' <- renameContext env co
-  return (c,co')
-
 renameContext :: Status -> Context -> Check Context
 renameContext b = renc [] where
   renc vs cont = case cont of
@@ -303,10 +316,3 @@ renameContext b = renc [] where
           return $ (bt,x,t') : xts'
     _ -> return cont
   ren = renameTerm b
-
--- | vars not needed in env, since patterns always overshadow old vars
-renameEquation :: Status -> [Ident] -> Equation -> Check Equation
-renameEquation b vs (ps,t) = do
-  (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
-  t'        <- renameTerm b (concat vs' ++ vs) t
-  return (ps',t')
diff --git a/src/compiler/GF/Compile/SubExOpt.hs b/src/compiler/GF/Compile/SubExOpt.hs
index c7dbb5d3d..73c349881 100644
--- a/src/compiler/GF/Compile/SubExOpt.hs
+++ b/src/compiler/GF/Compile/SubExOpt.hs
@@ -53,9 +53,9 @@ unsubexpModule sm@(i,mo)
     -- perform this iff the module has opers
     hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
     unparInfo (c,info) = case info of
-      CncFun xs (Just t) m -> [(c, CncFun xs (Just (unparTerm t)) m)]
-      ResOper (Just (EInt 8)) _ -> [] -- subexp-generated opers
-      ResOper pty (Just t) -> [(c, ResOper pty (Just (unparTerm t)))]
+      CncFun xs (Just (L loc t)) m -> [(c, CncFun xs (Just (L loc (unparTerm t))) m)]
+      ResOper (Just (L loc (EInt 8))) _ -> [] -- subexp-generated opers
+      ResOper pty (Just (L loc t)) -> [(c, ResOper pty (Just (L loc (unparTerm t))))]
       _ -> [(c,info)]
     unparTerm t = case t of
       Q m c | isOperIdent c -> --- name convention of subexp opers
@@ -76,12 +76,12 @@ addSubexpConsts mo tree lins = do
   mapM mkOne $ opers ++ lins
  where
    mkOne (f,def) = case def of
-     CncFun xs (Just trm) pn -> do
+     CncFun xs (Just (L loc trm)) pn -> do
        trm' <- recomp f trm
-       return (f,CncFun xs (Just trm') pn)
-     ResOper ty (Just trm) -> do
+       return (f,CncFun xs (Just (L loc trm')) pn)
+     ResOper ty (Just (L loc trm)) -> do
        trm' <- recomp f trm
-       return (f,ResOper ty (Just trm'))
+       return (f,ResOper ty (Just (L loc trm')))
      _ -> return (f,def)
    recomp f t = case Map.lookup t tree of
      Just (_,id) | operIdent id /= f -> return $ Q mo (operIdent id)
@@ -89,7 +89,7 @@ addSubexpConsts mo tree lins = do
 
    list = Map.toList tree
 
-   oper id trm = (operIdent id, ResOper (Just (EInt 8)) (Just trm)) 
+   oper id trm = (operIdent id, ResOper (Just (L (0,0) (EInt 8))) (Just (L (0,0) trm))) 
    --- impossible type encoding generated opers
 
 getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
@@ -99,10 +99,10 @@ getSubtermsMod mo js = do
   return $ Map.filter (\ (nu,_) -> nu > 1) tree0
  where
    getInfo get fi@(f,i) = case i of
-     CncFun xs (Just trm) pn -> do
+     CncFun xs (Just (L _ trm)) pn -> do
        get trm
        return $ fi
-     ResOper ty (Just trm) -> do
+     ResOper ty (Just (L _ trm)) -> do
        get trm
        return $ fi
      _ -> return fi
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 6ee0dc65b..1da650340 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -77,7 +77,7 @@ extendModule gr (name,m)
 -- | rebuilding instance + interface, and "with" modules, prior to renaming. 
 -- AR 24/10/2003
 rebuildModule :: SourceGrammar -> SourceModule -> Err SourceModule
-rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_ ps_)) = do
+rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_)) = do
 ----  deps <- moduleDeps ms
 ----  is   <- openInterfaces deps i
   let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005
@@ -100,8 +100,7 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_ ps_)) = do
                 m0s <- mapM (lookupModule gr) j0s
                 let notInM0 c _  = all (not . isInBinTree c . jments) m0s
                 let js2 = filterBinTree notInM0 js'
-                return $ (replaceJudgements mi js2) 
-                  {positions = Map.union (positions m1) (positions mi)}
+                return $ replaceJudgements mi js2
         _ -> return mi
 
     -- add the instance opens to an incomplete module "with" instances
@@ -111,7 +110,7 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_ ps_)) = do
                     [i | i <- is, notElem i infs]
       testErr (stat' == MSComplete || stat == MSIncomplete) 
               ("module" +++ showIdent i +++ "remains incomplete")
-      ModInfo mt0 _ fs me' _ ops0 _ js ps0 <- lookupModule gr ext
+      ModInfo mt0 _ fs me' _ ops0 _ js <- lookupModule gr ext
       let ops1 = nub $
                    ops_ ++ -- N.B. js has been name-resolved already
                    [OQualif i j | (i,j) <- ops] ++
@@ -123,9 +122,8 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_ ps_)) = do
       let fs1 = fs `addOptions` fs_                           -- new flags have priority
       let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
       let js1 = buildTree (tree2list js_ ++ js0)
-      let ps1 = Map.union ps_ ps0
       let med1= nub (ext : infs ++ insts ++ med_)
-      return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 js1 ps1
+      return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 js1
 
   return (i,mi')
 
@@ -170,9 +168,9 @@ extendMod gr isCompl (name,cond) base old new = foldM try new $ Map.toList old
 unifyAnyInfo :: Ident -> Info -> Info -> Err Info
 unifyAnyInfo m i j = case (i,j) of
   (AbsCat mc1, AbsCat mc2) -> 
-    liftM AbsCat (unifMaybe mc1 mc2)
+    liftM AbsCat (unifMaybeL mc1 mc2)
   (AbsFun mt1 ma1 md1, AbsFun mt2 ma2 md2) -> 
-    liftM3 AbsFun (unifMaybe mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
+    liftM3 AbsFun (unifMaybeL mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
 
   (ResParam mt1 mv1, ResParam mt2 mv2) ->
     liftM2 ResParam (unifMaybe mt1 mt2) (unifMaybe mv1 mv2)
@@ -182,12 +180,12 @@ unifyAnyInfo m i j = case (i,j) of
   (_, ResOverload ms t) | elem m ms ->
     return $ ResOverload ms t
   (ResOper mt1 m1, ResOper mt2 m2) -> 
-    liftM2 ResOper (unifMaybe mt1 mt2) (unifMaybe m1 m2)
+    liftM2 ResOper (unifMaybeL mt1 mt2) (unifMaybeL m1 m2)
 
   (CncCat mc1 mf1 mp1, CncCat mc2 mf2 mp2) -> 
-    liftM3 CncCat (unifMaybe mc1 mc2) (unifMaybe mf1 mf2) (unifMaybe mp1 mp2)
+    liftM3 CncCat (unifMaybeL mc1 mc2) (unifMaybeL mf1 mf2) (unifMaybeL mp1 mp2)
   (CncFun m mt1 md1, CncFun _ mt2 md2) -> 
-    liftM2 (CncFun m) (unifMaybe mt1 mt2) (unifMaybe md1 md2) ---- adding defs
+    liftM2 (CncFun m) (unifMaybeL mt1 mt2) (unifMaybeL md1 md2) ---- adding defs
 
   (AnyInd b1 m1, AnyInd b2 m2) -> do
     testErr (b1 == b2) $ "indirection status"
@@ -205,6 +203,15 @@ unifMaybe (Just p1) (Just p2)
   | p1==p2                    = return (Just p1)
   | otherwise                 = fail ""
 
+-- | this is what happens when matching two values in the same module
+unifMaybeL :: Eq a => Maybe (L a) -> Maybe (L a) -> Err (Maybe (L a))
+unifMaybeL Nothing          Nothing          = return Nothing
+unifMaybeL (Just p1)        Nothing          = return (Just p1)
+unifMaybeL Nothing          (Just p2)        = return (Just p2)
+unifMaybeL (Just (L l1 p1)) (Just (L l2 p2))
+  | p1==p2                                   = return (Just (L l1 p1))
+  | otherwise                                = fail ""
+
 unifAbsArrity :: Maybe Int -> Maybe Int -> Err (Maybe Int)
 unifAbsArrity Nothing   Nothing   = return Nothing
 unifAbsArrity (Just a ) Nothing   = return (Just a )
@@ -213,14 +220,8 @@ unifAbsArrity (Just a1) (Just a2)
   | a1==a2                        = return (Just a1)
   | otherwise                     = fail ""
 
-unifAbsDefs :: Maybe [Equation] -> Maybe [Equation] -> Err (Maybe [Equation])
+unifAbsDefs :: Maybe [L Equation] -> Maybe [L Equation] -> Err (Maybe [L Equation])
 unifAbsDefs Nothing   Nothing   = return Nothing
 unifAbsDefs (Just _ ) Nothing   = fail ""
 unifAbsDefs Nothing   (Just _ ) = fail ""
 unifAbsDefs (Just xs) (Just ys) = return (Just (xs ++ ys))
-
-unifConstrs :: Maybe [Term] -> Maybe [Term] -> Err (Maybe [Term])
-unifConstrs p1 p2 = case (p1,p2) of
-  (Nothing, _)  -> return p2
-  (_, Nothing)  -> return p1
-  (Just bs, Just ds) -> return $ Just $ bs ++ ds
diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs
index 1febdcd46..ff34ae38a 100644
--- a/src/compiler/GF/Grammar/Binary.hs
+++ b/src/compiler/GF/Grammar/Binary.hs
@@ -31,9 +31,9 @@ instance Binary a => Binary (MGrammar a) where
   get               = fmap MGrammar get

 

 instance Binary a => Binary (ModInfo a) where

-  put mi = do put (mtype mi,mstatus mi,flags mi,extend mi,mwith mi,opens mi,mexdeps mi,jments mi,positions mi)

-  get    = do (mtype,mstatus,flags,extend,mwith,opens,med,jments,positions) <- get

-              return (ModInfo mtype mstatus flags extend mwith opens med jments positions)

+  put mi = do put (mtype mi,mstatus mi,flags mi,extend mi,mwith mi,opens mi,mexdeps mi,jments mi)

+  get    = do (mtype,mstatus,flags,extend,mwith,opens,med,jments) <- get

+              return (ModInfo mtype mstatus flags extend mwith opens med jments)

 

 instance Binary ModuleType where

   put MTAbstract       = putWord8 0

@@ -109,6 +109,10 @@ instance Binary Info where
              8 -> get >>= \(x,y)   -> return (AnyInd x y)

              _ -> decodingError

 

+instance Binary a => Binary (L a) where

+  put (L x y) = put (x,y)

+  get = get >>= \(x,y) -> return (L x y)

+

 instance Binary BindType where

   put Explicit = putWord8 0

   put Implicit = putWord8 1

@@ -258,6 +262,6 @@ instance Binary Label where
 decodeModHeader :: FilePath -> IO SourceModule

 decodeModHeader fpath = do

   (m,mtype,mstatus,flags,extend,mwith,opens,med) <- decodeFile fpath

-  return (m,ModInfo mtype mstatus flags extend mwith opens med Map.empty Map.empty)

+  return (m,ModInfo mtype mstatus flags extend mwith opens med Map.empty)

 

 decodingError = fail "This GFO file was compiled with different version of GF"

diff --git a/src/compiler/GF/Grammar/CF.hs b/src/compiler/GF/Grammar/CF.hs
index e883d0552..06f67234b 100644
--- a/src/compiler/GF/Grammar/CF.hs
+++ b/src/compiler/GF/Grammar/CF.hs
@@ -50,9 +50,9 @@ getCFRule :: String -> Err [CFRule]
 getCFRule s = getcf (wrds s) where
   getcf ws = case ws of
     fun : cat : a : its | isArrow a -> 
-      Ok [(init fun, (cat, map mkIt its))]
+      Ok [L (0,0) (init fun, (cat, map mkIt its))]
     cat : a : its | isArrow a -> 
-      Ok [(mkFun cat it, (cat, map mkIt it)) | it <- chunk its]
+      Ok [L (0,0) (mkFun cat it, (cat, map mkIt it)) | it <- chunk its]
     _ -> Bad (" invalid rule:" +++ s)
   isArrow a = elem a ["->", "::="] 
   mkIt w = case w of
@@ -69,7 +69,7 @@ getCFRule s = getcf (wrds s) where
 
 type CF = [CFRule]
 
-type CFRule = (CFFun, (CFCat, [CFItem]))
+type CFRule = L (CFFun, (CFCat, [CFItem]))
 
 type CFItem = Either CFCat String
 
@@ -97,27 +97,27 @@ cf2grammar rules = (buildTree abs, buildTree conc, cat) where
   abs   = cats ++ funs
   conc  = lincats ++ lins
   cat   = case rules of
-            (_,(c,_)):_ -> c  -- the value category of the first rule
+            (L _ (_,(c,_))):_ -> c  -- the value category of the first rule
             _ -> error "empty CF" 
-  cats  = [(cat, AbsCat (Just [])) | 
+  cats  = [(cat, AbsCat (Just (L (0,0) []))) | 
              cat <- nub (concat (map cf2cat rules))] ----notPredef cat
-  lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _) <- cats]
+  lincats = [(cat, CncCat (Just (L loc defLinType)) Nothing Nothing) | (cat,AbsCat (Just (L loc _))) <- cats]
   (funs,lins) = unzip (map cf2rule rules)
 
 cf2cat :: CFRule -> [Ident]
-cf2cat (_,(cat, items)) = map identS $ cat : [c | Left c <- items]
+cf2cat (L loc (_,(cat, items))) = map identS $ cat : [c | Left c <- items]
 
 cf2rule :: CFRule -> ((Ident,Info),(Ident,Info))
-cf2rule (fun, (cat, items)) = (def,ldef) where
+cf2rule (L loc (fun, (cat, items))) = (def,ldef) where
   f     = identS fun
-  def   = (f, AbsFun (Just (mkProd args' (Cn (identS cat)) [])) Nothing Nothing)
+  def   = (f, AbsFun (Just (L loc (mkProd args' (Cn (identS cat)) []))) Nothing Nothing)
   args0 = zip (map (identS . ("x" ++) . show) [0..]) items
   args  = [((Explicit,v), Cn (identS c)) | (v, Left c) <- args0]
   args' = [(Explicit,identS "_", Cn (identS c)) | (_, Left c) <- args0]
   ldef  = (f, CncFun 
                Nothing 
-               (Just (mkAbs (map fst args) 
-                      (mkRecord (const theLinLabel) [foldconcat (map mkIt args0)])))
+               (Just (L loc (mkAbs (map fst args) 
+                      (mkRecord (const theLinLabel) [foldconcat (map mkIt args0)]))))
                Nothing)
   mkIt (v, Left _) = P (Vr v) theLinLabel
   mkIt (_, Right a) = K a
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 371e0ac08..4aa2ace51 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -20,6 +20,7 @@ module GF.Grammar.Grammar (SourceGrammar,
         SourceModule,
         mapSourceModule,
         Info(..),
+        L(..), unLoc,
         Type,
         Cat,
         Fun,
@@ -75,24 +76,33 @@ mapSourceModule f (i,mi) = (i, f mi)
 -- and indirection to module (/INDIR/)
 data Info =
 -- judgements in abstract syntax
-   AbsCat   (Maybe Context)
- | AbsFun   (Maybe Type) (Maybe Int) (Maybe [Equation])  -- ^ (/ABS/) type, arrity and definition of function
+   AbsCat   (Maybe (L Context))                                -- ^ (/ABS/) context of a category
+ | AbsFun   (Maybe (L Type)) (Maybe Int) (Maybe [L Equation])  -- ^ (/ABS/) type, arrity and definition of a function
 
 -- judgements in resource
- | ResParam (Maybe [Param]) (Maybe [Term])   -- ^ (/RES/) the second parameter is list of all possible values
- | ResValue Type                             -- ^ (/RES/) to mark parameter constructors for lookup
- | ResOper  (Maybe Type) (Maybe Term)        -- ^ (/RES/)
+ | ResParam (Maybe [L Param]) (Maybe [Term])     -- ^ (/RES/) the second parameter is list of all possible values
+ | ResValue (L Type)                             -- ^ (/RES/) to mark parameter constructors for lookup
+ | ResOper  (Maybe (L Type)) (Maybe (L Term))    -- ^ (/RES/)
 
- | ResOverload [Ident] [(Type,Term)]         -- ^ (/RES/) idents: modules inherited
+ | ResOverload [Ident] [(L Type,L Term)]         -- ^ (/RES/) idents: modules inherited
 
 -- judgements in concrete syntax
- | CncCat  (Maybe Type)                 (Maybe Term) (Maybe Term)  -- ^ (/CNC/) lindef ini'zed, 
- | CncFun  (Maybe (Ident,Context,Type)) (Maybe Term) (Maybe Term)  -- ^ (/CNC/) type info added at 'TC'
+ | CncCat  (Maybe (L Type))             (Maybe (L Term)) (Maybe (L Term))  -- ^ (/CNC/) lindef ini'zed, 
+ | CncFun  (Maybe (Ident,Context,Type)) (Maybe (L Term)) (Maybe (L Term))  -- ^ (/CNC/) type info added at 'TC'
 
 -- indirection to module Ident
  | AnyInd Bool Ident                         -- ^ (/INDIR/) the 'Bool' says if canonical
   deriving Show
 
+data L a = L (Int,Int) a  -- location information
+  deriving (Eq,Show)
+
+instance Functor L where
+  fmap f (L loc x) = L loc (f x)
+
+unLoc :: L a -> a
+unLoc (L _ x) = x
+
 type Type = Term
 type Cat  = QIdent
 type Fun  = QIdent
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index 14f1ab498..90d8263cd 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -67,13 +67,13 @@ lookupResDef gr m c
       mo <- lookupModule gr m
       info <- lookupIdentInfo mo c
       case info of
-        ResOper _ (Just t) -> return t
+        ResOper _ (Just (L _ t)) -> return t
         ResOper _ Nothing  -> return (Q m c)
-        CncCat (Just ty) _ _ -> lock c ty
+        CncCat (Just (L _ ty)) _ _ -> lock c ty
         CncCat _ _ _         -> lock c defLinType
       
-        CncFun (Just (cat,_,_)) (Just tr) _ -> unlock cat tr
-        CncFun _                (Just tr) _ -> return tr
+        CncFun (Just (cat,_,_)) (Just (L _ tr)) _ -> unlock cat tr
+        CncFun _                (Just (L _ tr)) _ -> return tr
 
         AnyInd _ n        -> look n c
         ResParam _ _      -> return (QC m c)
@@ -85,7 +85,7 @@ lookupResType gr m c = do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    ResOper (Just t) _ -> return t
+    ResOper (Just (L _ t)) _ -> return t
 
     -- used in reused concrete
     CncCat _ _ _ -> return typeType
@@ -94,7 +94,7 @@ lookupResType gr m c = do
           return $ mkProd cont val' []
     AnyInd _ n        -> lookupResType gr n c
     ResParam _ _      -> return typePType
-    ResValue t        -> return t
+    ResValue (L _ t)  -> return t
     _   -> Bad $ render (ppIdent c <+> text "has no type defined in resource" <+> ppIdent m)
 
 lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))]
@@ -105,7 +105,7 @@ lookupOverload gr m c = do
       ResOverload os tysts -> do
             tss <- mapM (\x -> lookupOverload gr x c) os
             return $ [let (args,val) = typeFormCnc ty in (map (\(b,x,t) -> t) args,(val,tr)) | 
-                      (ty,tr) <- tysts] ++ 
+                      (L _ ty,L _ tr) <- tysts] ++ 
                      concat tss
 
       AnyInd _ n  -> lookupOverload gr n c
@@ -153,7 +153,7 @@ lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c))
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    AbsFun _ a d -> return (a,d)
+    AbsFun _ a d -> return (a,fmap (map unLoc) d)
     AnyInd _ n   -> lookupAbsDef gr n c
     _            -> return (Nothing,Nothing)
 
@@ -163,9 +163,9 @@ lookupLincat gr m c = do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    CncCat (Just t) _ _ -> return t
-    AnyInd _ n          -> lookupLincat gr n c
-    _                   -> Bad (render (ppIdent c <+> text "has no linearization type in" <+> ppIdent m))
+    CncCat (Just (L _ t)) _ _ -> return t
+    AnyInd _ n                -> lookupLincat gr n c
+    _                         -> Bad (render (ppIdent c <+> text "has no linearization type in" <+> ppIdent m))
 
 -- | this is needed at compile time
 lookupFunType :: SourceGrammar -> Ident -> Ident -> Err Type
@@ -173,9 +173,9 @@ lookupFunType gr m c = do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    AbsFun (Just t) _ _  -> return t
-    AnyInd _ n           -> lookupFunType gr n c
-    _                    -> Bad (render (text "cannot find type of" <+> ppIdent c))
+    AbsFun (Just (L _ t)) _ _ -> return t
+    AnyInd _ n                -> lookupFunType gr n c
+    _                         -> Bad (render (text "cannot find type of" <+> ppIdent c))
 
 -- | this is needed at compile time
 lookupCatContext :: SourceGrammar -> Ident -> Ident -> Err Context
@@ -183,6 +183,6 @@ lookupCatContext gr m c = do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    AbsCat (Just co) -> return co
-    AnyInd _ n       -> lookupCatContext gr n c
-    _                -> Bad (render (text "unknown category" <+> ppIdent c))
+    AbsCat (Just (L _ co)) -> return co
+    AnyInd _ n             -> lookupCatContext gr n c
+    _                      -> Bad (render (text "unknown category" <+> ppIdent c))
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index ef68b740d..5282b30b1 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -607,15 +607,15 @@ allDependencies ism b =
       Q n c | ism n -> [c]
       QC n c | ism n -> [c]
       _ -> collectOp opersIn t
-    opty (Just ty) = opersIn ty
+    opty (Just (L _ ty)) = opersIn ty
     opty _ = []
     pts i = case i of
       ResOper pty pt -> [pty,pt]
-      ResParam (Just ps) _ -> [Just t | (_,cont) <- ps, (_,_,t) <- cont]
+      ResParam (Just ps) _ -> [Just (L loc t) | L loc (_,cont) <- ps, (_,_,t) <- cont]
       CncCat pty _ _ -> [pty]
       CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
       AbsFun pty _ ptr -> [pty] --- ptr is def, which can be mutual
-      AbsCat (Just co) -> [Just ty | (_,_,ty) <- co]
+      AbsCat (Just (L loc co)) -> [Just (L loc ty) | (_,_,ty) <- co]
       _              -> []
 
 topoSortJments :: SourceModule -> Err [(Ident,Info)]
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index 2346953a9..16cea88b8 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -113,23 +113,17 @@ ModDef
                                           (extends,with,content) = $4
                                           (opens,jments,opts) = case content of { Just c -> c; Nothing -> ([],[],noOptions) }
                                       mapM_ (checkInfoType mtype) jments
-                                      defs <- case buildAnyTree id [(i,d) | (i,_,d) <- jments] of
+                                      defs <- case buildAnyTree id jments of
                                                 Ok x    -> return x
                                                 Bad msg -> fail msg
-                                      let poss  = buildTree [(i,(fname,mkSrcSpan p)) | (i,p,_) <- jments]
-                                          fname = showIdent id ++ ".gf"
-                                          
-                                          mkSrcSpan :: (Posn, Posn) -> (Int,Int)
-					  mkSrcSpan (Pn l1 _, Pn l2 _) = (l1,l2)
-
-                                      return (id, ModInfo mtype mstat opts extends with opens [] defs poss)  }
+                                      return (id, ModInfo mtype mstat opts extends with opens [] defs)  }
 
 ModHeader :: { SourceModule }
 ModHeader
   : ComplMod ModType '=' ModHeaderBody { let { mstat = $1 ;
                                                (mtype,id) = $2 ;
                                                (extends,with,opens) = $4 }
-                                         in (id, ModInfo mtype mstat noOptions extends with opens [] emptyBinTree emptyBinTree) }
+                                         in (id, ModInfo mtype mstat noOptions extends with opens [] emptyBinTree) }
 
 ComplMod :: { ModuleStatus }
 ComplMod 
@@ -164,7 +158,7 @@ ModOpen
 
 ModBody :: { ( [(Ident,MInclude)]
              , Maybe (Ident,MInclude,[(Ident,Ident)])
-             , Maybe ([OpenSpec],[(Ident,SrcSpan,Info)],Options)
+             , Maybe ([OpenSpec],[(Ident,Info)],Options)
              ) }
 ModBody
   : ListIncluded '**' Included 'with' ListInst '**' ModContent  { ($1, Just (fst $3,snd $3,$5), Just $7) }
@@ -176,12 +170,12 @@ ModBody
   |                                                 ModContent  { ([], Nothing,                 Just $1) }
   | ModBody ';'                                                 { $1                                     }
 
-ModContent :: { ([OpenSpec],[(Ident,SrcSpan,Info)],Options) }
+ModContent :: { ([OpenSpec],[(Ident,Info)],Options) }
 ModContent
   :                      '{' ListTopDef '}' { ([],[d | Left ds <- $2, d <- ds],concatOptions [o | Right o <- $2]) }
   | 'open' ListOpen 'in' '{' ListTopDef '}' { ($2,[d | Left ds <- $5, d <- ds],concatOptions [o | Right o <- $5]) }
 
-ListTopDef :: { [Either [(Ident,SrcSpan,Info)] Options] }
+ListTopDef :: { [Either [(Ident,Info)] Options] }
 ListTopDef
   : {- empty -}       { []      } 
   | TopDef ListTopDef { $1 : $2 }
@@ -216,7 +210,7 @@ Included
   | Ident     '[' ListIdent ']' { ($1,MIOnly   $3) }
   | Ident '-' '[' ListIdent ']' { ($1,MIExcept $4) }
 
-TopDef :: { Either [(Ident,SrcSpan,Info)] Options }
+TopDef :: { Either [(Ident,Info)] Options }
 TopDef
   : 'cat'             ListCatDef      { Left  $2 }
   | 'fun'             ListFunDef      { Left  $2 }
@@ -224,56 +218,56 @@ TopDef
   | 'data'            ListDataDef     { Left  $2 }
   | 'param'           ListParamDef    { Left  $2 }
   | 'oper'            ListOperDef     { Left  $2 }
-  | 'lincat'          ListTermDef     { Left  [(f, pos, CncCat (Just e) Nothing    Nothing   ) | (f,pos,e) <- $2] }
-  | 'lindef'          ListTermDef     { Left  [(f, pos, CncCat Nothing    (Just e) Nothing   ) | (f,pos,e) <- $2] }
+  | 'lincat'          ListTermDef     { Left  [(f, CncCat (Just e) Nothing    Nothing   ) | (f,e) <- $2] }
+  | 'lindef'          ListTermDef     { Left  [(f, CncCat Nothing    (Just e) Nothing   ) | (f,e) <- $2] }
   | 'lin'             ListLinDef      { Left  $2 }
-  | 'printname' 'cat' ListTermDef     { Left  [(f, pos, CncCat Nothing    Nothing (Just e)) | (f,pos,e) <- $3] }
-  | 'printname' 'fun' ListTermDef     { Left  [(f, pos, CncFun Nothing Nothing (Just e)) | (f,pos,e) <- $3] }
+  | 'printname' 'cat' ListTermDef     { Left  [(f, CncCat Nothing    Nothing (Just e)) | (f,e) <- $3] }
+  | 'printname' 'fun' ListTermDef     { Left  [(f, CncFun Nothing Nothing (Just e)) | (f,e) <- $3] }
   | 'flags'           ListFlagDef     { Right $2 }
 
-CatDef :: { [(Ident,SrcSpan,Info)] }
+CatDef :: { [(Ident,Info)] }
 CatDef
-  : Posn Ident ListDDecl                         Posn { [($2, ($1,$4), AbsCat (Just $3))]        }
-  | Posn '[' Ident ListDDecl ']'                 Posn { listCatDef $3 ($1,$6) $4 0                 }
-  | Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef $3 ($1,$9) $4 (fromIntegral $7) }
+  : Posn Ident ListDDecl                         Posn { [($2, AbsCat (Just (mkL $1 $4 $3)))]           }
+  | Posn '[' Ident ListDDecl ']'                 Posn { listCatDef (mkL $1 $6 ($3,$4,0))               }
+  | Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef (mkL $1 $9 ($3,$4,fromIntegral $7)) }
 
-FunDef :: { [(Ident,SrcSpan,Info)] }
+FunDef :: { [(Ident,Info)] }
 FunDef
-  : Posn ListIdent ':' Exp Posn { [(fun, ($1,$5), AbsFun (Just $4) Nothing (Just [])) | fun <- $2] } 
+  : Posn ListIdent ':' Exp Posn { [(fun, AbsFun (Just (mkL $1 $5 $4)) Nothing (Just [])) | fun <- $2] } 
 
-DefDef :: { [(Ident,SrcSpan,Info)] }
+DefDef :: { [(Ident,Info)] }
 DefDef
-  : Posn ListName '=' Exp         Posn { [(f, ($1,$5),AbsFun Nothing (Just 0) (Just [([],$4)])) | f <- $2] }
-  | Posn Name ListPatt '=' Exp    Posn { [($2,($1,$6),AbsFun Nothing (Just (length $3)) (Just [($3,$5)]))] }
+  : Posn ListName '=' Exp         Posn { [(f, AbsFun Nothing (Just 0)           (Just [mkL $1 $5 ([],$4)])) | f <- $2] }
+  | Posn Name ListPatt '=' Exp    Posn { [($2,AbsFun Nothing (Just (length $3)) (Just [mkL $1 $6 ($3,$5)]))] }
 
-DataDef :: { [(Ident,SrcSpan,Info)] }
+DataDef :: { [(Ident,Info)] }
 DataDef
-  : Posn Ident '=' ListDataConstr Posn { ($2,   ($1,$5), AbsCat Nothing) :
-                                         [(fun, ($1,$5), AbsFun Nothing   Nothing Nothing) | fun <- $4] }
-  | Posn ListIdent ':' Exp Posn        { -- (snd (valCat $4), ($1,$5), AbsCat Nothing) :
-                                         [(fun, ($1,$5), AbsFun (Just $4) Nothing Nothing) | fun <- $2] }                                         
+  : Posn Ident '=' ListDataConstr Posn { ($2,   AbsCat Nothing) :
+                                         [(fun, AbsFun Nothing   Nothing Nothing) | fun <- $4] }
+  | Posn ListIdent ':' Exp Posn        { -- (snd (valCat $4), AbsCat Nothing) :
+                                         [(fun, AbsFun (Just (mkL $1 $5 $4)) Nothing Nothing) | fun <- $2] }                                         
 
-ParamDef :: { [(Ident,SrcSpan,Info)] }
+ParamDef :: { [(Ident,Info)] }
 ParamDef
-  : Posn Ident '=' ListParConstr Posn {  ($2, ($1,$5), ResParam (Just $4) Nothing) :
-                                        [(f,  ($1,$5), ResValue (mkProdSimple co (Cn $2))) | (f,co) <- $4] }
-  | Posn Ident                   Posn { [($2, ($1,$3), ResParam Nothing   Nothing)] }
+  : Ident '=' ListParConstr { ($1, ResParam (Just $3) Nothing) :
+                              [(f, ResValue (L loc (mkProdSimple co (Cn $1)))) | L loc (f,co) <- $3] }
+  | Ident                   { [($1, ResParam Nothing Nothing)] }
 
-OperDef :: { [(Ident,SrcSpan,Info)] }
+OperDef :: { [(Ident,Info)] }
 OperDef
-  : Posn ListName ':' Exp         Posn { [(i, ($1,$5), info) | i <- $2,   info <- mkOverload (Just $4) Nothing  ] } 
-  | Posn ListName '=' Exp         Posn { [(i, ($1,$5), info) | i <- $2,   info <- mkOverload Nothing   (Just $4)] }
-  | Posn Name ListArg '=' Exp     Posn { [(i, ($1,$6), info) | i <- [$2], info <- mkOverload Nothing   (Just (mkAbs $3 $5))] }
-  | Posn ListName ':' Exp '=' Exp Posn { [(i, ($1,$7), info) | i <- $2,   info <- mkOverload (Just $4) (Just $6)] }
+  : Posn ListName ':' Exp         Posn { [(i, info) | i <- $2,   info <- mkOverload (Just (mkL $1 $5 $4)) Nothing  ] } 
+  | Posn ListName '=' Exp         Posn { [(i, info) | i <- $2,   info <- mkOverload Nothing   (Just (mkL $1 $5 $4))] }
+  | Posn Name ListArg '=' Exp     Posn { [(i, info) | i <- [$2], info <- mkOverload Nothing   (Just (mkL $1 $6 (mkAbs $3 $5)))] }
+  | Posn ListName ':' Exp '=' Exp Posn { [(i, info) | i <- $2,   info <- mkOverload (Just (mkL $1 $7 $4)) (Just (mkL $1 $7 $6))] }
 
-LinDef :: { [(Ident,SrcSpan,Info)] }
+LinDef :: { [(Ident,Info)] }
 LinDef
-  : Posn ListName '=' Exp         Posn { [(f,  ($1,$5), CncFun Nothing (Just $4) Nothing) | f <- $2] }
-  | Posn Name ListArg '=' Exp     Posn { [($2, ($1,$6), CncFun Nothing (Just (mkAbs $3 $5)) Nothing)] }
+  : Posn ListName '=' Exp         Posn { [(f,  CncFun Nothing (Just (mkL $1 $5 $4)) Nothing) | f <- $2] }
+  | Posn Name ListArg '=' Exp     Posn { [($2, CncFun Nothing (Just (mkL $1 $6 (mkAbs $3 $5))) Nothing)] }
 
-TermDef :: { [(Ident,SrcSpan,Term)] }
+TermDef :: { [(Ident,L Term)] }
 TermDef
-  : Posn ListName '=' Exp Posn { [(i,($1,$5),$4) | i <- $2] } 
+  : Posn ListName '=' Exp Posn { [(i,mkL $1 $5 $4) | i <- $2] } 
 
 FlagDef :: { Options }
 FlagDef
@@ -286,46 +280,46 @@ ListDataConstr
   : Ident                    { [$1]    }
   | Ident '|' ListDataConstr { $1 : $3 }
 
-ParConstr :: { Param }
+ParConstr :: { L Param }
 ParConstr
-  : Ident ListDDecl { ($1,$2) } 
+  : Posn Ident ListDDecl Posn { mkL $1 $4 ($2,$3) } 
 
-ListLinDef :: { [(Ident,SrcSpan,Info)] }
+ListLinDef :: { [(Ident,Info)] }
 ListLinDef
   : LinDef ';'            { $1       } 
   | LinDef ';' ListLinDef { $1 ++ $3 }
 
-ListDefDef :: { [(Ident,SrcSpan,Info)] }
+ListDefDef :: { [(Ident,Info)] }
 ListDefDef
   : DefDef ';'            { $1       } 
   | DefDef ';' ListDefDef { $1 ++ $3 }
 
-ListOperDef :: { [(Ident,SrcSpan,Info)] }
+ListOperDef :: { [(Ident,Info)] }
 ListOperDef
   : OperDef ';'             { $1       } 
   | OperDef ';' ListOperDef { $1 ++ $3 }
 
-ListCatDef :: { [(Ident,SrcSpan,Info)] }
+ListCatDef :: { [(Ident,Info)] }
 ListCatDef
   : CatDef ';'            { $1       } 
   | CatDef ';' ListCatDef { $1 ++ $3 }
 
-ListFunDef :: { [(Ident,SrcSpan,Info)] }
+ListFunDef :: { [(Ident,Info)] }
 ListFunDef
   : FunDef ';'            { $1       }
   | FunDef ';' ListFunDef { $1 ++ $3 }
 
-ListDataDef :: { [(Ident,SrcSpan,Info)] }
+ListDataDef :: { [(Ident,Info)] }
 ListDataDef
   : DataDef ';'             { $1       } 
   | DataDef ';' ListDataDef { $1 ++ $3 }
 
-ListParamDef :: { [(Ident,SrcSpan,Info)] }
+ListParamDef :: { [(Ident,Info)] }
 ListParamDef
   : ParamDef ';'              { $1       } 
   | ParamDef ';' ListParamDef { $1 ++ $3 }
 
-ListTermDef :: { [(Ident,SrcSpan,Term)] }
+ListTermDef :: { [(Ident,L Term)] }
 ListTermDef
   : TermDef ';'             { $1       } 
   | TermDef ';' ListTermDef { $1 ++ $3 }
@@ -335,7 +329,7 @@ ListFlagDef
   : FlagDef ';'               { $1               } 
   | FlagDef ';' ListFlagDef   { addOptions $1 $3 }
 
-ListParConstr :: { [Param] }
+ListParConstr :: { [L Param] }
 ListParConstr
   : ParConstr                   { [$1]    }
   | ParConstr '|' ListParConstr { $1 : $3 }
@@ -620,16 +614,16 @@ mkBaseId = prefixId (BS.pack "Base")
 prefixId :: BS.ByteString -> Ident -> Ident
 prefixId pref id = identC (BS.append pref (ident2bs id))
 
-listCatDef :: Ident -> SrcSpan -> Context -> Int -> [(Ident,SrcSpan,Info)]
-listCatDef id pos cont size = [catd,nilfund,consfund]
+listCatDef :: L (Ident, Context, Int) -> [(Ident,Info)]
+listCatDef (L loc (id,cont,size)) = [catd,nilfund,consfund]
   where
     listId = mkListId id
     baseId = mkBaseId id
     consId = mkConsId id
 
-    catd     = (listId, pos, AbsCat (Just cont'))
-    nilfund  = (baseId, pos, AbsFun (Just niltyp)  Nothing Nothing)
-    consfund = (consId, pos, AbsFun (Just constyp) Nothing Nothing)
+    catd     = (listId, AbsCat (Just (L loc cont')))
+    nilfund  = (baseId, AbsFun (Just (L loc niltyp))  Nothing Nothing)
+    consfund = (consId, AbsFun (Just (L loc constyp)) Nothing Nothing)
 
     cont' = [(b,mkId x i,ty) | (i,(b,x,ty)) <- zip [0..] cont]
     xs = map (\(b,x,t) -> Vr x) cont'
@@ -656,16 +650,16 @@ mkR fs@(f:_) =
     tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))
     tryR (lab,_  ,_     ) = fail $ "illegal record field" +++ showIdent lab
 
-mkOverload pdt pdf@(Just df) =
+mkOverload pdt pdf@(Just (L loc df)) =
   case appForm df of
     (keyw, ts@(_:_)) | isOverloading keyw -> 
        case last ts of
-         R fs -> [ResOverload [m | Vr m <- ts] [(ty,fu) | (_,(Just ty,fu)) <- fs]]
+         R fs -> [ResOverload [m | Vr m <- ts] [(L loc ty,L loc fu) | (_,(Just ty,fu)) <- fs]]
          _    -> [ResOper pdt pdf]
     _         -> [ResOper pdt pdf]
 
      -- to enable separare type signature --- not type-checked
-mkOverload pdt@(Just df) pdf =
+mkOverload pdt@(Just (L _ df)) pdf =
   case appForm df of
     (keyw, ts@(_:_)) | isOverloading keyw ->
        case last ts of
@@ -680,29 +674,26 @@ isOverloading t =
     _                                      -> False
 
 
-type SrcSpan = (Posn,Posn)
-
-
-checkInfoType MTAbstract       (id,pos,info) =
+checkInfoType MTAbstract       (id,info) =
   case info of
     AbsCat _     -> return ()
     AbsFun _ _ _ -> return ()
-    _            -> failLoc (fst pos) "illegal definition in abstract module" 
-checkInfoType MTResource       (id,pos,info) =
+    _            -> failLoc (getInfoPos info) "illegal definition in abstract module" 
+checkInfoType MTResource       (id,info) =
   case info of
     ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
-    _            -> failLoc (fst pos) "illegal definition in resource module" 
-checkInfoType MTInterface      (id,pos,info) =
+    _            -> failLoc (getInfoPos info) "illegal definition in resource module" 
+checkInfoType MTInterface      (id,info) =
   case info of
     ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
-    _            -> failLoc (fst pos) "illegal definition in interface module" 
-checkInfoType (MTConcrete _)   (id,pos,info) =
+    _            -> failLoc (getInfoPos info) "illegal definition in interface module" 
+checkInfoType (MTConcrete _)   (id,info) =
   case info of
     CncCat _ _ _ -> return ()
     CncFun _ _ _ -> return ()
@@ -710,14 +701,15 @@ checkInfoType (MTConcrete _)   (id,pos,info) =
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
     ResOverload _ _ -> return ()
-    _            -> failLoc (fst pos) "illegal definition in concrete module" 
-checkInfoType (MTInstance _)   (id,pos,info) =
+    _            -> failLoc (getInfoPos info) "illegal definition in concrete module" 
+checkInfoType (MTInstance _)   (id,info) =
   case info of
     ResParam _ _ -> return ()
     ResValue _   -> return ()
     ResOper  _ _ -> return ()
-    _            -> failLoc (fst pos) "illegal definition in instance module" 
+    _            -> failLoc (getInfoPos info) "illegal definition in instance module" 
 
+getInfoPos = undefined
 
 mkAlts cs = case cs of
   _:_ -> do
@@ -741,5 +733,7 @@ mkAlts cs = case cs of
      PM m c -> return (Q m c) --- for macros; not yet complete
      _ -> fail "no strs from pattern"
 
-}
+mkL :: Posn -> Posn -> x -> L x
+mkL (Pn l1 _) (Pn l2 _) x = L (l1,l2) x
 
+}
\ No newline at end of file
diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs
index 15afef865..1db1eb4f3 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -16,6 +16,7 @@ module GF.Grammar.Printer
            , ppPatt

            , ppValue

            , ppConstrs

+           , ppPosition

            ) where

 

 import GF.Infra.Ident

@@ -32,7 +33,7 @@ import qualified Data.Map as Map
 data TermPrintQual = Qualified | Unqualified

 

 ppModule :: TermPrintQual -> SourceModule -> Doc

-ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments _) =

+ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments) =

     hdr $$ nest 2 (ppOptions opts $$ vcat (map (ppJudgement q) defs)) $$ ftr

     where

       defs = Map.toList jments

@@ -74,15 +75,15 @@ ppOptions opts =
 ppJudgement q (id, AbsCat pcont ) =

   text "cat" <+> ppIdent id <+>

   (case pcont of

-     Just cont -> hsep (map (ppDecl q) cont)

-     Nothing   -> empty) <+> semi

+     Just (L _ cont) -> hsep (map (ppDecl q) cont)

+     Nothing         -> empty) <+> semi

 ppJudgement q (id, AbsFun ptype _ pexp) =

   (case ptype of

-     Just typ   -> text (if isNothing pexp then "data" else "fun") <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi

-     Nothing    -> empty) $$

+     Just (L _ typ) -> text (if isNothing pexp then "data" else "fun") <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi

+     Nothing        -> empty) $$

   (case pexp of

      Just []  -> empty

-     Just eqs -> text "def" <+> vcat [ppIdent id <+> hsep (map (ppPatt q 2) ps) <+> equals <+> ppTerm q 0 e <+> semi | (ps,e) <- eqs]

+     Just eqs -> text "def" <+> vcat [ppIdent id <+> hsep (map (ppPatt q 2) ps) <+> equals <+> ppTerm q 0 e <+> semi | L _ (ps,e) <- eqs]

      Nothing  -> empty)

 ppJudgement q (id, ResParam pparams _) = 

   text "param" <+> ppIdent id <+>

@@ -92,31 +93,31 @@ ppJudgement q (id, ResParam pparams _) =
 ppJudgement q (id, ResValue pvalue) = empty

 ppJudgement q (id, ResOper  ptype pexp) =

   text "oper" <+> ppIdent id <+>

-  (case ptype of {Just t -> colon  <+> ppTerm q 0 t; Nothing -> empty} $$

-   case pexp  of {Just e -> equals <+> ppTerm q 0 e; Nothing -> empty}) <+> semi

+  (case ptype of {Just (L _ t) -> colon  <+> ppTerm q 0 t; Nothing -> empty} $$

+   case pexp  of {Just (L _ e) -> equals <+> ppTerm q 0 e; Nothing -> empty}) <+> semi

 ppJudgement q (id, ResOverload ids defs) =

   text "oper" <+> ppIdent id <+> equals <+> 

   (text "overload" <+> lbrace $$

-   nest 2 (vcat [ppIdent id <+> (colon <+> ppTerm q 0 ty $$ equals <+> ppTerm q 0 e) | (ty,e) <- defs]) $$

+   nest 2 (vcat [ppIdent id <+> (colon <+> ppTerm q 0 ty $$ equals <+> ppTerm q 0 e) | (L _ ty,L _ e) <- defs]) $$

    rbrace) <+> semi

 ppJudgement q (id, CncCat  ptype pexp pprn) =

   (case ptype of

-     Just typ -> text "lincat" <+> ppIdent id <+> equals <+> ppTerm q 0 typ <+> semi

-     Nothing  -> empty) $$

+     Just (L _ typ) -> text "lincat" <+> ppIdent id <+> equals <+> ppTerm q 0 typ <+> semi

+     Nothing        -> empty) $$

   (case pexp of

-     Just exp -> text "lindef" <+> ppIdent id <+> equals <+> ppTerm q 0 exp <+> semi

-     Nothing  -> empty) $$

+     Just (L _ exp) -> text "lindef" <+> ppIdent id <+> equals <+> ppTerm q 0 exp <+> semi

+     Nothing        -> empty) $$

   (case pprn of

-     Just prn -> text "printname" <+> text "cat" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi

-     Nothing  -> empty)

+     Just (L _ prn) -> text "printname" <+> text "cat" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi

+     Nothing        -> empty)

 ppJudgement q (id, CncFun  ptype pdef pprn) =

   (case pdef of

-     Just e  -> let (xs,e') = getAbs e

-              in text "lin" <+> ppIdent id <+> hsep (map ppBind xs) <+> equals <+> ppTerm q 0 e' <+> semi

-     Nothing -> empty) $$

+     Just (L _ e) -> let (xs,e') = getAbs e

+                     in text "lin" <+> ppIdent id <+> hsep (map ppBind xs) <+> equals <+> ppTerm q 0 e' <+> semi

+     Nothing      -> empty) $$

   (case pprn of

-     Just prn -> text "printname" <+> text "fun" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi

-     Nothing  -> empty)

+     Just (L _ prn) -> text "printname" <+> text "fun" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi

+     Nothing        -> empty)

 ppJudgement q (id, AnyInd cann mid) = text "ind" <+> ppIdent id <+> equals <+> (if cann then text "canonical" else empty) <+> ppIdent mid <+> semi

 

 ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)

@@ -257,7 +258,12 @@ ppBind (Implicit,v) = braces (ppIdent v)
 

 ppAltern q (x,y) = ppTerm q 0 x <+> char '/' <+> ppTerm q 0 y

 

-ppParam q (id,cxt) = ppIdent id <+> hsep (map (ppDDecl q) cxt)

+ppParam q (L _ (id,cxt)) = ppIdent id <+> hsep (map (ppDDecl q) cxt)

+

+ppPosition :: Ident -> (Int,Int) -> Doc

+ppPosition m (b,e)

+  | b == e    = text "in" <+> ppIdent m <> text ".gf, line"  <+> int b

+  | otherwise = text "in" <+> ppIdent m <> text ".gf, lines" <+> int b <> text "-" <> int e

 

 commaPunct f ds = (hcat (punctuate comma (map f ds)))

 

diff --git a/src/compiler/GF/Infra/Modules.hs b/src/compiler/GF/Infra/Modules.hs
index 40941c398..af930f881 100644
--- a/src/compiler/GF/Infra/Modules.hs
+++ b/src/compiler/GF/Infra/Modules.hs
@@ -32,7 +32,6 @@ module GF.Infra.Modules (
         emptyMGrammar, emptyModInfo,
         abstractOfConcrete, abstractModOfConcrete,
         lookupModule, lookupModuleType, lookupInfo,
-        lookupPosition, ppPosition,
         isModAbs, isModRes, isModCnc,
         sameMType, isCompilableModule, isCompleteModule,
         allAbstracts, greatestAbstract, allResources,
@@ -64,8 +63,7 @@ data ModInfo a = ModInfo {
     mwith   :: Maybe (Ident,MInclude,[(Ident,Ident)]),
     opens   :: [OpenSpec],
     mexdeps :: [Ident],
-    jments  :: Map.Map Ident a,
-    positions :: Map.Map Ident (String,(Int,Int)) -- file, first line, last line
+    jments  :: Map.Map Ident a
   }
   deriving Show
 
@@ -105,13 +103,13 @@ updateMGrammar old new = MGrammar $
    ns = modules new
 
 updateModule :: ModInfo t -> Ident -> t -> ModInfo t
-updateModule (ModInfo mt ms fs me mw ops med js ps) i t = ModInfo mt ms fs me mw ops med (updateTree (i,t) js) ps
+updateModule (ModInfo mt ms fs me mw ops med js) i t = ModInfo mt ms fs me mw ops med (updateTree (i,t) js)
 
 replaceJudgements :: ModInfo t -> Map.Map Ident t -> ModInfo t
-replaceJudgements (ModInfo mt ms fs me mw ops med _ ps) js = ModInfo mt ms fs me mw ops med js ps
+replaceJudgements (ModInfo mt ms fs me mw ops med _) js = ModInfo mt ms fs me mw ops med js
 
 addOpenQualif :: Ident -> Ident -> ModInfo t -> ModInfo t
-addOpenQualif i j (ModInfo mt ms fs me mw ops med js ps) = ModInfo mt ms fs me mw (OQualif i j : ops) med js ps
+addOpenQualif i j (ModInfo mt ms fs me mw ops med js) = ModInfo mt ms fs me mw (OQualif i j : ops) med js
 
 addFlag :: Options -> ModInfo t -> ModInfo t
 addFlag f mo = mo {flags = flags mo `addOptions` f} 
@@ -216,7 +214,7 @@ emptyMGrammar :: MGrammar a
 emptyMGrammar = MGrammar []
 
 emptyModInfo :: ModInfo a
-emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] emptyBinTree emptyBinTree
+emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] emptyBinTree
 
 -- | we store the module type with the identifier
 
@@ -250,15 +248,6 @@ lookupModuleType gr m = do
 lookupInfo :: ModInfo a -> Ident -> Err a
 lookupInfo mo i = lookupTree showIdent i (jments mo)
 
-lookupPosition :: ModInfo a -> Ident -> Err (String,(Int,Int))
-lookupPosition mo i = lookupTree showIdent i (positions mo)
-
-ppPosition :: ModInfo a -> Ident -> Doc
-ppPosition mo i = case lookupPosition mo i of
-  Ok (f,(b,e)) | b == e    -> text "in" <+> text f <> text ", line" <+> int b
-               | otherwise -> text "in" <+> text f <> text ", lines" <+> int b <> text "-" <> int e
-  _ -> empty
-
 isModAbs :: ModInfo a -> Bool
 isModAbs m =
   case mtype m of
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 84bfc43c5..e80403145 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -120,7 +120,7 @@ loop opts gfenv0 = do
                
                (style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
 
-               checkComputeTerm gr t = do
+               checkComputeTerm gr (L _ t) = do
                  mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
                  ((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t
                                             inferLType gr [] t
@@ -128,7 +128,7 @@ loop opts gfenv0 = do
 
              case runP pExp (BS.pack s) of
                Left (_,msg) -> putStrLn msg
-               Right t      -> case checkComputeTerm sgr (codeTerm (decode gfenv) t) of
+               Right t      -> case checkComputeTerm sgr (codeTerm (decode gfenv) (L (0,0) t)) of
                                  Ok  x -> putStrLn $ enc (showTerm sgr style q x)
                                  Bad s -> putStrLn $ enc s
              loopNewCPU gfenv