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

1 files changed, 11 insertions, 11 deletions

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