1
0
forked from GitHub/gf-core

CheckGrammar is now using the printer in GF.Grammar.Printer. Fixed bug that was hiding the warnings

This commit is contained in:
krasimir
2009-09-14 12:16:02 +00:00
parent 4ef98f44d2
commit 5d06550283
17 changed files with 224 additions and 299 deletions

View File

@@ -54,16 +54,16 @@ unlock c = unlockRecord c -- return
-- to look up a constant etc in a search tree --- why here? AR 29/5/2008
lookupIdent :: Ident -> BinTree Ident b -> Err b
lookupIdent c t =
case lookupTree prIdent c t of
case lookupTree showIdent c t of
Ok v -> return v
Bad _ -> Bad ("unknown identifier" +++ prIdent c)
Bad _ -> Bad ("unknown identifier" +++ showIdent c)
lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a
lookupIdentInfo mo i = lookupIdent i (jments mo)
lookupIdentInfoIn :: ModInfo Ident a -> Ident -> Ident -> Err a
lookupIdentInfoIn mo m i =
err (\s -> Bad (s +++ "in module" +++ prIdent m)) return $ lookupIdentInfo mo i
err (\s -> Bad (s +++ "in module" +++ showIdent m)) return $ lookupIdentInfo mo i
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term
lookupResDef gr m c = liftM fst $ lookupResDefKind gr m c

View File

@@ -214,7 +214,7 @@ freeVarsExp e = case e of
_ -> [] --- thus applies to abstract syntax only
ident2string :: Ident -> String
ident2string = prIdent
ident2string = showIdent
{-
tree :: (TrNode,[Tree]) -> Tree
tree = Tr

View File

@@ -350,10 +350,10 @@ float2term = EFloat
-- | create a terminal from identifier
ident2terminal :: Ident -> Term
ident2terminal = K . prIdent
ident2terminal = K . showIdent
symbolOfIdent :: Ident -> String
symbolOfIdent = prIdent
symbolOfIdent = showIdent
symid :: Ident -> String
symid = symbolOfIdent

View File

@@ -753,7 +753,7 @@ happyReduction_3 (happy_x_4 `HappyStk`
Ok x -> return x
Bad msg -> fail msg
let poss = buildTree [(i,(fname,mkSrcSpan p)) | (i,p,_) <- jments]
fname = prIdent id ++ ".gf"
fname = showIdent id ++ ".gf"
mkSrcSpan :: (Posn, Posn) -> (Int,Int)
mkSrcSpan (Pn l1 _, Pn l2 _) = (l1,l2)

View File

@@ -117,7 +117,7 @@ ModDef
Ok x -> return x
Bad msg -> fail msg
let poss = buildTree [(i,(fname,mkSrcSpan p)) | (i,p,_) <- jments]
fname = prIdent id ++ ".gf"
fname = showIdent id ++ ".gf"
mkSrcSpan :: (Posn, Posn) -> (Int,Int)
mkSrcSpan (Pn l1 _, Pn l2 _) = (l1,l2)
@@ -278,7 +278,7 @@ TermDef
FlagDef :: { Options }
FlagDef
: Posn Ident '=' Ident Posn {% case parseModuleOptions ["--" ++ prIdent $2 ++ "=" ++ prIdent $4] of
: Posn Ident '=' Ident Posn {% case parseModuleOptions ["--" ++ showIdent $2 ++ "=" ++ showIdent $4] of
Ok x -> return x
Bad msg -> failLoc $1 msg }
@@ -626,7 +626,7 @@ listCatDef id pos cont size = [catd,nilfund,consfund]
mkId x i = if isWildIdent x then (varX i) else x
tryLoc (c,mty,Just e) = return (c,(mty,e))
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ prIdent c +++ "without value")
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ showIdent c +++ "without value")
mkR [] = return $ RecType [] --- empty record always interpreted as record type
mkR fs@(f:_) =
@@ -635,10 +635,10 @@ mkR fs@(f:_) =
_ -> mapM tryR fs >>= return . R
where
tryRT (lab,Just ty,Nothing) = return (ident2label lab,ty)
tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ prIdent lab --- manifest fields ?!
tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ showIdent lab --- manifest fields ?!
tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))
tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ prIdent lab
tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ showIdent lab
mkOverload pdt pdf@(Just df) =
case appForm df of
@@ -660,8 +660,8 @@ mkOverload pdt pdf = [ResOper pdt pdf]
isOverloading t =
case t of
Vr keyw | prIdent keyw == "overload" -> True -- overload is a "soft keyword"
_ -> False
Vr keyw | showIdent keyw == "overload" -> True -- overload is a "soft keyword"
_ -> False
type SrcSpan = (Posn,Posn)

View File

@@ -235,7 +235,7 @@ ppDDecl q (id,typ)
| id == identW = ppTerm q 6 typ
| otherwise = parens (ppIdent id <+> colon <+> ppTerm q 0 typ)
ppIdent = text . prIdent
ppIdent = text . showIdent
ppQIdent q m id =
case q of