From 1fd85fbe516f029c199bc27d49736e512ea0c3d7 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 5 Feb 2008 23:06:03 +0000 Subject: [PATCH] Added the -fwarn-missing-signatures option and added all missing type signatures for non-test modules (and most for test modules too) --- Makefile.am | 5 +---- common/AST.hs | 3 +++ common/FlowGraph.hs | 3 +++ common/FlowGraphTest.hs | 3 +++ common/Pattern.hs | 5 ++++- frontends/LexOccam.x | 2 +- frontends/LexRain.x | 2 +- frontends/ParseOccam.hs | 25 +++++++++++++++++++++++++ frontends/ParseRain.hs | 4 ++++ 9 files changed, 45 insertions(+), 7 deletions(-) diff --git a/Makefile.am b/Makefile.am index 8d52b1a..8f67d00 100644 --- a/Makefile.am +++ b/Makefile.am @@ -4,6 +4,7 @@ GHC_OPTS = \ -fwarn-duplicate-exports \ -fwarn-missing-fields \ -fwarn-missing-methods \ + -fwarn-missing-signatures \ -fwarn-overlapping-patterns \ -fwarn-simple-patterns \ -fwarn-type-defaults \ @@ -11,10 +12,6 @@ GHC_OPTS = \ -fwarn-unused-imports \ -ibackends -ichecks -icommon -ifrontends -itransformations -# TODO turn on this option too: -# -fwarn-missing-signatures - - if GHC68 GHC_OPTS += -XUndecidableInstances -fwarn-tabs -fwarn-monomorphism-restriction else diff --git a/common/AST.hs b/common/AST.hs index e0e8e91..5c25e69 100644 --- a/common/AST.hs +++ b/common/AST.hs @@ -381,6 +381,9 @@ data Data a => Structured a = -- that leaving GHC to handle deriving (Data) will not achieve. Therefore we have no -- choice but to provide our own instance long-hand here: +_struct_RepConstr, _struct_SpecConstr, _struct_ProcThenConstr, _struct_OnlyConstr, _struct_SeveralConstr :: Constr +_struct_DataType :: DataType + _struct_RepConstr = mkConstr _struct_DataType "Rep" [] Prefix _struct_SpecConstr = mkConstr _struct_DataType "Spec" [] Prefix _struct_ProcThenConstr= mkConstr _struct_DataType "ProcThen" [] Prefix diff --git a/common/FlowGraph.hs b/common/FlowGraph.hs index e162772..373f051 100644 --- a/common/FlowGraph.hs +++ b/common/FlowGraph.hs @@ -367,6 +367,7 @@ buildStructured f outer (A.Rep m rep str) route buildStructured f outer (A.Only _ o) route = f outer (route22 route A.Only) o >>* Right buildStructured _ _ s _ = return $ Left False +buildOnlyChoice :: (Monad mLabel, Monad mAlter) => OuterType -> ASTModifier mAlter A.Choice structType -> A.Choice -> GraphMaker mLabel mAlter label structType (Node, Node) buildOnlyChoice outer route (A.Choice m exp p) = do nexp <- addNodeExpression (findMeta exp) exp $ route23 route A.Choice (nbodys, nbodye) <- buildProcess p $ route33 route A.Choice @@ -377,6 +378,8 @@ buildOnlyChoice outer route (A.Choice m exp p) addEdge ESeq nbodye cEnd _ -> throwError "Choice found outside IF statement" return (nexp,nbodye) + +buildOnlyOption :: (Monad mLabel, Monad mAlter) => OuterType -> ASTModifier mAlter A.Option structType -> A.Option -> GraphMaker mLabel mAlter label structType (Node, Node) buildOnlyOption outer route opt = do (s,e) <- case opt of diff --git a/common/FlowGraphTest.hs b/common/FlowGraphTest.hs index dae7ae2..120a37f 100644 --- a/common/FlowGraphTest.hs +++ b/common/FlowGraphTest.hs @@ -44,6 +44,7 @@ import Utils makeMeta :: Int -> Meta makeMeta n = Meta (Just "FlowGraphTest") n 0 +m0, m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11, mU :: Meta -- To make typing the tests as short as possible (typing a function call means bracketing is needed, which is a pain): m0 = makeMeta 0 m1 = makeMeta 1 @@ -64,6 +65,7 @@ mU = makeMeta (-1) sub :: Meta -> Int -> Meta sub m n = m {metaColumn = n} +sm0, sm1, sm2, sm3, sm4, sm5, sm6, sm7, sm8, sm9, sm10, sm11 :: A.Process -- Various abbreviations for unique A.Process items sm0 = A.Skip m0 sm1 = A.Skip m1 @@ -578,6 +580,7 @@ genReplicator = nextIdT >>* makeMeta' >>= \m -> genElem4 A.For m (comb0 $ simple class ReplicatorAnnotation a where replicatorItem :: (Int, Int -> GenL a) -> Maybe (Int, Int -> GenL (A.Structured a)) +replicatorItem' :: (ReplicatorAnnotation a, Data a) => (Int, Int -> GenL a) -> (Int, Int -> GenL (A.Structured a)) replicatorItem' x = (4, genElem3 A.Rep m genReplicator . genStructured x . sub3) --Replicators are allowed in ALTs, IFs, SEQs and PARs: diff --git a/common/Pattern.hs b/common/Pattern.hs index 7c257c7..6719e06 100644 --- a/common/Pattern.hs +++ b/common/Pattern.hs @@ -47,13 +47,16 @@ instance Data Pattern where gunfold _ _ _ = error "gunfold Pattern" dataTypeOf _ = ty_Pattern - + +ty_Pattern :: DataType ty_Pattern = mkDataType "TreeUtil.Pattern" [ constr_DontCare ,constr_Named ,constr_Match ] + +constr_DontCare, constr_Named, constr_Match :: Constr constr_DontCare = mkConstr ty_Pattern "DontCare" [] Prefix constr_Named = mkConstr ty_Pattern "Named" [] Prefix diff --git a/frontends/LexOccam.x b/frontends/LexOccam.x index 4986663..0e1e88f 100644 --- a/frontends/LexOccam.x +++ b/frontends/LexOccam.x @@ -1,4 +1,4 @@ -{ {-# OPTIONS_GHC -fno-warn-unused-imports #-} +{ {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-} {- Tock: a compiler for parallel languages Copyright (C) 2007 University of Kent diff --git a/frontends/LexRain.x b/frontends/LexRain.x index 9d3b652..8cae9de 100644 --- a/frontends/LexRain.x +++ b/frontends/LexRain.x @@ -1,4 +1,4 @@ -{ {-# OPTIONS_GHC -fno-warn-unused-imports #-} +{ {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-} {- Tock: a compiler for parallel languages Copyright (C) 2007 University of Kent diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index ef646cc..12d4e4a 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -82,6 +82,8 @@ plainToken t = genToken test test (_, t') = if t == t' then Just () else Nothing --}}} --{{{ symbols +sAmp, sAssign, sBang, sColon, sColons, sComma, sEq, sLeft, sLeftR, sQuest, sRight, sRightR, sSemi :: OccParser () + sAmp = reserved "&" sAssign = reserved ":=" sBang = reserved "!" @@ -97,6 +99,14 @@ sRightR = reserved ")" sSemi = reserved ";" --}}} --{{{ keywords +sAFTER, sALT, sAND, sANY, sAT, sBITAND, sBITNOT, sBITOR, sBOOL, sBYTE, sBYTESIN, sCASE, sCHAN, sDATA, + sELSE, sFALSE, sFOR, sFROM, sFUNCTION, sIF, sINLINE, sIN, sINT, sINT16, sINT32, sINT64, sIS, + sMINUS, sMOSTNEG, sMOSTPOS, sNOT, sOF, sOFFSETOF, sOR, sPACKED, sPAR, sPLACE, sPLACED, sPLUS, + sPORT, sPRI, sPROC, sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, sREM, sRESHAPES, sRESULT, + sRETYPES, sROUND, sSEQ, sSIZE, sSKIP, sSTOP, sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, + sWHILE, sWORKSPACE, sVECSPACE + :: OccParser () + sAFTER = reserved "AFTER" sALT = reserved "ALT" sAND = reserved "AND" @@ -165,6 +175,8 @@ sWORKSPACE = reserved "WORKSPACE" sVECSPACE = reserved "VECSPACE" --}}} --{{{ markers inserted by the preprocessor +indent, outdent, eol :: OccParser () + indent = do { plainToken Indent } "indentation increase" outdent = do { plainToken Outdent } "indentation decrease" eol = do { plainToken EndOfLine } "end of line" @@ -499,6 +511,10 @@ name nt newName :: A.NameType -> OccParser A.Name newName nt = anyName nt +channelName, dataTypeName, functionName, portName, procName, protocolName, + recordName, timerName, variableName + :: OccParser A.Name + channelName = name A.ChannelName dataTypeName = name A.DataTypeName functionName = name A.FunctionName @@ -509,6 +525,10 @@ recordName = name A.RecordName timerName = name A.TimerName variableName = name A.VariableName +newChannelName, newDataTypeName, newFunctionName, newPortName, newProcName, newProtocolName, + newRecordName, newTimerName, newVariableName + :: OccParser A.Name + newChannelName = newName A.ChannelName newDataTypeName = newName A.DataTypeName newFunctionName = newName A.FunctionName @@ -530,6 +550,8 @@ unscopedName nt findUnscopedName n show nt +fieldName, tagName, newFieldName, newTagName :: OccParser A.Name + fieldName = unscopedName A.FieldName tagName = unscopedName A.TagName newFieldName = unscopedName A.FieldName @@ -899,7 +921,9 @@ expressionOfType wantT matchType (findMeta e) wantT t return e +intExpr :: OccParser A.Expression intExpr = expressionOfType A.Int "integer expression" +booleanExpr :: OccParser A.Expression booleanExpr = expressionOfType A.Bool "boolean expression" constExprOfType :: A.Type -> OccParser A.Expression @@ -910,6 +934,7 @@ constExprOfType wantT dieReport (m,"expression is not constant (" ++ msg ++ ")") return e' +constIntExpr :: OccParser A.Expression constIntExpr = constExprOfType A.Int "constant integer expression" operandOfType :: A.Type -> OccParser A.Expression diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index bbaeb43..988fe0c 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -44,6 +44,10 @@ instance Die (GenParser tok st) where dieReport (Just m, err) = fail $ packMeta m err dieReport (Nothing, err) = fail err +sLeftQ, sRightQ, sLeftR, sRightR, sLeftC, sRightC, sSemiColon, sColon, sComma, sIn, sOut, sDots, + sPar, sSeq, sAlt, sPri, sSeqeach, sPareach, sChannel, sOne2One, sIf, sElse, sWhile, sProcess, sFunction, sRun, sReturn, sWait, sFor, sUntil + :: RainParser Meta + --{{{ Symbols sLeftQ = reserved "[" sRightQ = reserved "]"