@@ -30,6 +30,7 @@ import Idris.ParseHelpers
30import Idris.ParseOps
30import Idris.ParseOps
31import Idris.ParseExpr
31import Idris.ParseExpr
32import Idris.ParseData
32import Idris.ParseData
33+import Core.CoreParser (opChars)
34import Paths_idris
35import Paths_idris
@@ -245,13 +246,11 @@ syntaxSym = try (do lchar '['; n <- name; lchar ']'
245 FunDecl ::= FunDecl';
246 FunDecl ::= FunDecl';
247fnDecl :: SyntaxInfo -> IdrisParser [PDecl]
248fnDecl :: SyntaxInfo -> IdrisParser [PDecl]
249− = try (do notEndBlock
249+fnDecl syn = try (do notEndBlock
250− d <- fnDecl' syn
250+ d <- fnDecl' syn
251− i <- get
251+ i <- get
252− let d' = fmap (desugar syn i) d
252+ let d' = fmap (desugar syn i) d
254− <?> "function declaration"
253+ return [d']) <?> "function declaration"
256{- Parses a function declaration
255{- Parses a function declaration
257 FunDecl' ::=
256 FunDecl' ::=
@@ -262,7 +261,8 @@ fnDecl syn
264fnDecl' :: SyntaxInfo -> IdrisParser PDecl
263fnDecl' :: SyntaxInfo -> IdrisParser PDecl
264+fnDecl' syn = checkFixity $
265−fnDecl' syn = do (doc, fc, opts', n, acc) <- try (do
265+ do (doc, fc, opts', n, acc) <- try (do
266 doc <- option "" (docComment '|')
266 doc <- option "" (docComment '|')
267 pushIndent
267 pushIndent
268 ist <- get
268 ist <- get
@@ -285,7 +285,22 @@ fnDecl' syn = do (doc, fc, opts', n, acc) <- try (do
285 <|> caf syn
285 <|> caf syn
286 <|> pattern syn
286 <|> pattern syn
287 <?> "function declaration"
287 <?> "function declaration"
288−
288+ where checkFixity :: IdrisParser PDecl -> IdrisParser PDecl
289+ checkFixity p = do decl <- p
290+ case getName decl of
291+ Nothing -> return decl
292+ Just n -> do fOk <- fixityOK n
294+ "Missing fixity declaration for " ++ show n
296+ getName (PTy _ _ _ _ n _) = Just n
298+ fixityOK (NS n _) = fixityOK n
299+ fixityOK (UN n) | all (flip elem opChars) n =
300+ do fixities <- fmap idris_infixes get
301+ return . elem n . map (\ (Fix _ op) -> op) $ fixities
302+ | otherwise = return True
303+ fixityOK _ = return True
290{- Parses function options given initial options
305{- Parses function options given initial options
291FnOpts ::= 'total'
306FnOpts ::= 'total'
@@ -649,7 +664,8 @@ clause syn
649 pushIndent
664 pushIndent
650 l <- argExpr syn
665 l <- argExpr syn
651 op <- operator
666 op <- operator
667+ when (op == "=" || op == "?=" ) $
652− when (op == "=" || op == "?=" ) (fail "infix clause definition with \"=\" and \"?=\" not supported ")
668+ fail "infix clause definition with \"=\" and \"?=\" not supported "
653 return (l, op))
669 return (l, op))
654 let n = expandNS syn (UN op)
670 let n = expandNS syn (UN op)
655 r <- argExpr syn
671 r <- argExpr syn