GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-10 19:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
krasimir
2010-03-22 21:15:29 +00:00
parent d1615144b6
commit d3a84f994b
23 changed files with 322 additions and 323 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
src/compiler/GF/Grammar/CF.hs
View File

@@ -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