finally setup an LSP - fixed all warnings
This commit is contained in:
@@ -1,9 +1,9 @@
|
||||
module Parser where
|
||||
|
||||
import Monpar
|
||||
import Control.Applicative ((<|>), Alternative, many, some)
|
||||
import Control.Applicative ((<|>), many, some)
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isDigit, digitToInt)
|
||||
import Control.Monad (MonadPlus(mzero), void)
|
||||
|
||||
type ZorthAST = [ZorthExpr]
|
||||
|
||||
@@ -35,21 +35,18 @@ pZorthUnsignedInteger = ZorthASTInteger . foldr (\n t -> n + t*10) 0 . reverse
|
||||
|
||||
pZorthSignedInteger :: Parser ZorthExpr
|
||||
pZorthSignedInteger = do
|
||||
char '-'
|
||||
_ <- char '-'
|
||||
(ZorthASTInteger i) <- pZorthUnsignedInteger
|
||||
return $ ZorthASTInteger $ negate i
|
||||
|
||||
pZorthInteger :: Parser ZorthExpr
|
||||
pZorthInteger = do
|
||||
skipNonsenseSymbols
|
||||
i <- pZorthSignedInteger <|> pZorthUnsignedInteger
|
||||
return i
|
||||
pZorthInteger = skipNonsenseSymbols >> pZorthSignedInteger <|> pZorthUnsignedInteger
|
||||
|
||||
pZorthWord :: Parser ZorthExpr
|
||||
pZorthWord = do
|
||||
skipNonsenseSymbols
|
||||
_ <- skipNonsenseSymbols
|
||||
w <- word1
|
||||
eof <|> (nonsenseSymbol >> return ())
|
||||
eof <|> void nonsenseSymbol
|
||||
return $ ZorthASTWord w
|
||||
|
||||
pZorthWordDecl :: Parser ZorthExpr
|
||||
|
||||
Reference in New Issue
Block a user