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

use the new more accurate location information for some error messages

Browse Source
This commit is contained in:
krasimir
2010-03-23 15:24:48 +00:00
parent 1e51690b71
commit c80c403da2
2 changed files with 26 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/compiler/GF/Compile/CheckGrammar.hs
View File

@@ -166,9 +166,9 @@ checkInfo ms (m,mo) c info = do
mkCheck loc "type of function" $
checkTyp gr typ
case md of
Just eqs -> mkCheck loc "definition of function" $
checkDef gr (m,c) typ eqs
Nothing -> return info
Just eqs -> mapM_ (\(L loc eq) -> mkCheck loc "definition of function" $
checkDef gr (m,c) typ eq) eqs
Nothing -> return ()
return (AbsFun (Just (L loc typ)) ma md)
CncFun linty@(Just (cat,cont,val)) (Just (L loc trm)) mpr -> chIn loc "linearization of" $ do
@@ -187,17 +187,21 @@ checkInfo ms (m,mo) c info = do
mpr <- checkPrintname gr mpr
return (CncCat (Just (L loc typ)) mdef mpr)
ResOper pty pde -> chIn (0,0) "operation" $ do
ResOper pty pde -> do
(pty', pde') <- case (pty,pde) of
(Just (L loc1 ty), Just (L loc2 de)) -> do
ty' <- checkLType gr [] ty typeType >>= computeLType gr [] . fst
(de',_) <- checkLType gr [] de ty'
return (Just (L loc1 ty'), Just (L loc2 de'))
(_ , Just (L loc de)) -> do
(de',ty') <- inferLType gr [] de
return (Just (L loc ty'), Just (L loc de'))
(_ , Nothing) -> do
checkError (text "No definition given to the operation")
(Just (L loct ty), Just (L locd de)) -> do
ty' <- chIn loct "operation" $
checkLType gr [] ty typeType >>= computeLType gr [] . fst
(de',_) <- chIn locd "operation" $
checkLType gr [] de ty'
return (Just (L loct ty'), Just (L locd de'))
(Nothing , Just (L locd de)) -> do
(de',ty') <- chIn locd "operation" $
inferLType gr [] de
return (Just (L locd ty'), Just (L locd de'))
(Just (L loct ty), Nothing) -> do
chIn loct "operation" $
checkError (text "No definition given to the operation")
return (ResOper pty' pde')
ResOverload os tysts -> chIn (0,0) "overloading" $ do
@@ -211,7 +215,7 @@ 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 (0,0) "parameter type" $ do
ResParam (Just pcs) _ -> do
ts <- checkErr $ liftM concat $ mapM mkPar pcs
return (ResParam (Just pcs) (Just ts))
@@ -220,9 +224,10 @@ checkInfo ms (m,mo) c info = do
gr = MGrammar ((m,mo) : ms)
chIn loc cat = checkIn (text "Happened in" <+> text cat <+> ppIdent c <+> ppPosition m loc <> colon)
mkPar (L _ (f,co)) = do
vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
return $ map (mkApp (QC m f)) vs
mkPar (L loc (f,co)) =
chIn loc "parameter type" $ do
vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
return $ map (mkApp (QC m f)) vs
checkUniq xss = case xss of
x:y:xs