git.iko.soy/Idris-dev
on master help sign in
Unify almost identical checkFixity' functions.
commit635fb4087c1b536ddb00a7e0831693bcf059e856 authorBjörn Aili <bjorn.aili@gmail.com> dateMon 1 Aug 2016, 07:54 (10 years ago) parent0af8366
3 files changed+25−30
compare with master
unifiedsplit
src/Idris/Parser.hs+1−9 src/Idris/Parser/Data.hs+3−11 src/Idris/Parser/Ops.hs+21−10
src/Idris/Parser.hs+1−9
@@ -598,7 +598,7 @@ fnDecl syn = try (do notEndBlock
598598@
599599-}
600600fnDecl' :: SyntaxInfo -> IdrisParser PDecl
601−fnDecl' syn = checkFixity' $
601+fnDecl' syn = checkDeclFixity $
602602 do (doc, argDocs, fc, opts', n, nfc, acc) <- try (do
603603 pushIndent
604604 (doc, argDocs) <- docstring syn
@@ -618,14 +618,6 @@ fnDecl' syn = checkFixity' $
618618 <|> caf syn
619619 <|> pattern syn
620620 <?> "function declaration"
621− where checkFixity' :: IdrisParser PDecl -> IdrisParser PDecl
622− checkFixity' p = do decl <- p
623− case getName decl of
624− Nothing -> return decl
625− Just n -> do checkFixity n
626− return decl
627− getName (PTy _ _ _ _ _ n _ _) = Just n
628− getName _ = Nothing
629621
630622{-| Parses a series of function and accessbility options
631623
src/Idris/Parser/Data.hs+3−11
@@ -198,7 +198,7 @@ SimpleConstructorList ::=
198198 ;
199199-}
200200data_ :: SyntaxInfo -> IdrisParser PDecl
201−data_ syn = checkFixity' $
201+data_ syn = checkDeclFixity $
202202 do (doc, argDocs, acc, dataOpts) <- try (do
203203 (doc, argDocs) <- option noDocs docComment
204204 pushIndent
@@ -251,14 +251,6 @@ data_ syn = checkFixity' $
251251 return d)
252252 <?> "data type declaration"
253253 where
254− checkFixity' :: IdrisParser PDecl -> IdrisParser PDecl
255− checkFixity' p = do decl <- p
256− case getName decl of
257− Nothing -> return decl
258− Just n -> do checkFixity n
259− return decl
260− getName (PData _ _ _ _ _ (PDatadecl tyn _ _ _)) = Just tyn
261− getName _ = Nothing
262254 mkPApp :: FC -> PTerm -> [PTerm] -> PTerm
263255 mkPApp fc t [] = t
264256 mkPApp fc t xs = PApp fc t (map pexp xs)
@@ -286,7 +278,7 @@ constructor syn
286278 let doc' = annotCode (tryFullExpr syn ist) doc
287279 argDocs' = [ (n, annotCode (tryFullExpr syn ist) d)
288280 | (n, d) <- argDocs ]
289− checkFixity cn
281+ checkNameFixity cn
290282 return (doc', argDocs', cn, nfc, ty, fc, fs)
291283 <?> "constructor"
292284
@@ -303,7 +295,7 @@ simpleConstructor syn
303295 fc <- getFC
304296 args <- many (do notEndApp
305297 simpleExpr syn)
306− checkFixity cn
298+ checkNameFixity cn
307299 return (doc', [], cn, nfc, args, fc, [])
308300 <?> "constructor"
309301
src/Idris/Parser/Ops.hs+21−10
@@ -161,16 +161,27 @@ fixity = do pushIndent
161161 extractName :: FixDecl -> String
162162 extractName (Fix _ n) = n
163163
164−{- | Checks that an operator name also has a fixity declaration -}
165−checkFixity :: Name -> IdrisParser ()
166−checkFixity n = do fOk <- fixityOk n
167− unless fOk . fail $
168− "Missing fixity declaration for " ++ show n
169− where fixityOk (NS n _) = fixityOk n
170− fixityOk (UN n) | all (flip elem opChars) (str n) =
171− do fixities <- fmap idris_infixes get
172− return . elem (str n) . map (\ (Fix _ op) -> op) $ fixities
173− | otherwise = return True
164+-- | Check that a declaration of an operator also has fixity declared
165+checkDeclFixity :: IdrisParser PDecl -> IdrisParser PDecl
166+checkDeclFixity p = do decl <- p
167+ case getDeclName decl of
168+ Nothing -> return decl
169+ Just n -> do checkNameFixity n
170+ return decl
171+ where getDeclName (PTy _ _ _ _ _ n _ _ ) = Just n
172+ getDeclName (PData _ _ _ _ _ (PDatadecl n _ _ _)) = Just n
173+ getDeclName _ = Nothing
174+
175+-- | Checks that an operator name also has a fixity declaration
176+checkNameFixity :: Name -> IdrisParser ()
177+checkNameFixity n = do fOk <- fixityOk n
178+ unless fOk . fail $
179+ "Missing fixity declaration for " ++ show n
180+ where fixityOk (NS n' _) = fixityOk n'
181+ fixityOk (UN n') | all (flip elem opChars) (str n') =
182+ do fixities <- fmap idris_infixes get
183+ return . elem (str n') . map (\ (Fix _ op) -> op) $ fixities
184+ | otherwise = return True
174185 fixityOk _ = return True
175186
176187{- | Parses a fixity declaration type (i.e. infix or prefix, associtavity)