Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
214 views
in Technique[技术] by (71.8m points)

parsing - Handling token error in calculator program

I'm trying to handle token errors in the calculator programme I made with haskell, my code is as follows:

import Data.Char
import Control.Applicative

data MayError a = Value a | Error String

instance (Show a) => Show (MayError a) where
  show (Value x) = show x
  show (Error s) = "error: " ++ s

instance Functor MayError where
  fmap f (Value x) = Value (f x)
  fmap f (Error s) = Error s

instance Applicative MayError where
  pure x = Value x
  (Value f) <*> (Value x) = Value (f x)
  (Value f) <*> (Error s) = Error s
  (Error s) <*> _ = Error s

instance Monad MayError where
  return x = Value x
  (Value x) >>= f = f x
  (Error s) >>= f = Error s

{- tokenizer -}
data Token = Num Int | Add | Sub | Mul | Div | Exp | LPar | RPar deriving (Eq, Show)

tokens :: String -> MayError [Token]
tokens [] = []
tokens ('+':cs) = Add:(tokens cs)
tokens ('-':cs) = Sub:(tokens cs)
tokens ('*':cs) = Mul:(tokens cs)
tokens ('/':cs) = Div:(tokens cs)
tokens ('(':cs) = LPar:(tokens cs)
tokens (')':cs) = RPar:(tokens cs)
tokens ('^':cs) = Exp:(tokens cs)
tokens (c:cs) | isDigit c = let (ds,rs) = span isDigit (c:cs)
                            in Num(read ds):(tokens rs)
              | isSpace c = tokens cs
              | otherwise = Error "unknown token"

{- parser -}
data ParseTree = Number Int |
                 Plus ParseTree ParseTree |
                 Minus ParseTree ParseTree |
                 Times ParseTree ParseTree |
                 Divide ParseTree ParseTree |
                 Power ParseTree ParseTree
                 deriving Show

type Parser = [Token] -> MayError(ParseTree, [Token])

parseFactor::Parser
parseFactor (Num x:l) = return (Number x, l)
parseFactor (Add:l) = parseFactor l
parseFactor (Sub:l) = let (p1, l1) = parseFactor l in (Minus (Number 0) p1, l1)
parseFactor (LPar:l) = let (p1, RPar:l1) = parseExpr l in (p1, l1)
parseFactor _ = Error "parse error"

parseExponent::Parser
parseExponent l = nextExp $ parseFactor l
  where nextExp(p1, Exp:l1) = let (p2, l2) = parseFactor l1
                              in nextExp(Power p1 p2, l2)
        nextExp x = x

parseTerm::Parser
parseTerm l = nextFactor $ parseExponent l
  where nextFactor(p1, Mul:l1) = let (p2,l2) = parseExponent l1
                                 in nextFactor(Times p1 p2, l2)
        nextFactor(p1, Div:l1) = let (p2,l2) = parseExponent l1
                                 in nextFactor(Divide p1 p2, l2)
        nextFactor x = x

parseExpr::Parser
parseExpr l = nextTerm $ parseTerm l
  where nextTerm(p1, Add:l1) = let (p2,l2) = parseTerm l1
                               in nextTerm(Plus p1 p2, l2)
        nextTerm(p1, Sub:l1) = let (p2,l2) = parseTerm l1
                               in nextTerm(Minus p1 p2, l2)
        nextTerm x = x

{- evaluator -}
eval::ParseTree -> MayError Int
eval (Number x) = Value x
eval (Plus p1 p2) = do x <- eval p1
                       y <- eval p2
                       return (x+y)
eval (Minus p1 p2) = do x <- eval p1
                        y <- eval p2
                        return (x-y)
eval (Times p1 p2) = do x <- eval p1
                        y <- eval p2
                        return (x*y)
eval (Divide p1 p2) = do x <- eval p1
                         y <- eval p2
                         if y == 0 then Error "division by 0" 
                                   else return (x `div` y)
eval (Power p1 p2) = do x <- eval p1
                        y <- eval p2
                        if y < 0 then Error "cannot process negative exponents"
                                 else return (x^y)

parse :: [Token] ->  MayError ParseTree
parse ts = do (pt, rs) <- parseExpr ts
              if null rs then return pt else Error "extra token"                                                                                                                                         

{- main -}
main = do cs <- getContents
          putStr $ unlines $ map show $
            map (s -> tokens s >>= parse >>= eval) $ lines cs

Everything works fine when I wasn't trying to parse errors, but now the error is as shown below:

calc_final2.hs:29:13: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[a1]’
    ? In the expression: []
      In an equation for ‘tokens’: tokens [] = []
   |
29 | tokens [] = []
   |             ^^

calc_final2.hs:30:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Add : (tokens cs)
      In an equation for ‘tokens’: tokens ('+' : cs) = Add : (tokens cs)
   |
30 | tokens ('+':cs) = Add:(tokens cs)
   |                   ^^^^^^^^^^^^^^^

calc_final2.hs:30:24: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: Add : (tokens cs)
      In an equation for ‘tokens’: tokens ('+' : cs) = Add : (tokens cs)
   |
30 | tokens ('+':cs) = Add:(tokens cs)
   |                        ^^^^^^^^^

calc_final2.hs:31:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Sub : (tokens cs)
      In an equation for ‘tokens’: tokens ('-' : cs) = Sub : (tokens cs)
   |
31 | tokens ('-':cs) = Sub:(tokens cs)
   |                   ^^^^^^^^^^^^^^^

calc_final2.hs:31:24: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: Sub : (tokens cs)
      In an equation for ‘tokens’: tokens ('-' : cs) = Sub : (tokens cs)
   |
31 | tokens ('-':cs) = Sub:(tokens cs)
   |                        ^^^^^^^^^

calc_final2.hs:32:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Mul : (tokens cs)
      In an equation for ‘tokens’: tokens ('*' : cs) = Mul : (tokens cs)
   |
32 | tokens ('*':cs) = Mul:(tokens cs)
   |                   ^^^^^^^^^^^^^^^

calc_final2.hs:32:24: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: Mul : (tokens cs)
      In an equation for ‘tokens’: tokens ('*' : cs) = Mul : (tokens cs)
   |
32 | tokens ('*':cs) = Mul:(tokens cs)
   |                        ^^^^^^^^^

calc_final2.hs:33:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Div : (tokens cs)
      In an equation for ‘tokens’: tokens ('/' : cs) = Div : (tokens cs)
   |
33 | tokens ('/':cs) = Div:(tokens cs)
   |                   ^^^^^^^^^^^^^^^

calc_final2.hs:33:24: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: Div : (tokens cs)
      In an equation for ‘tokens’: tokens ('/' : cs) = Div : (tokens cs)
   |
33 | tokens ('/':cs) = Div:(tokens cs)
   |                        ^^^^^^^^^

calc_final2.hs:34:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: LPar : (tokens cs)
      In an equation for ‘tokens’: tokens ('(' : cs) = LPar : (tokens cs)
   |
34 | tokens ('(':cs) = LPar:(tokens cs)
   |                   ^^^^^^^^^^^^^^^^

calc_final2.hs:34:25: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: LPar : (tokens cs)
      In an equation for ‘tokens’: tokens ('(' : cs) = LPar : (tokens cs)
   |
34 | tokens ('(':cs) = LPar:(tokens cs)
   |                         ^^^^^^^^^

calc_final2.hs:35:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: RPar : (tokens cs)
      In an equation for ‘tokens’: tokens (')' : cs) = RPar : (tokens cs)
   |
35 | tokens (')':cs) = RPar:(tokens cs)
   |                   ^^^^^^^^^^^^^^^^

calc_final2.hs:35:25: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: RPar : (tokens cs)
      In an equation for ‘tokens’: tokens (')' : cs) = RPar : (tokens cs)
   |
35 | tokens (')':cs) = RPar:(tokens cs)
   |                         ^^^^^^^^^

calc_final2.hs:36:19: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Exp : (tokens cs)
      In an equation for ‘tokens’: tokens ('^' : cs) = Exp : (tokens cs)
   |
36 | tokens ('^':cs) = Exp:(tokens cs)
   |                   ^^^^^^^^^^^^^^^

calc_final2.hs:36:24: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens cs)’
      In the expression: Exp : (tokens cs)
      In an equation for ‘tokens’: tokens ('^' : cs) = Exp : (tokens cs)
   |
36 | tokens ('^':cs) = Exp:(tokens cs)
   |                        ^^^^^^^^^

calc_final2.hs:38:32: error:
    ? Couldn't match expected type ‘MayError [Token]’
                  with actual type ‘[Token]’
    ? In the expression: Num (read ds) : (tokens rs)
      In the expression:
        let (ds, rs) = span isDigit (c : cs) in Num (read ds) : (tokens rs)
      In an equation for ‘tokens’:
          tokens (c : cs)
            | isDigit c
            = let (ds, rs) = span isDigit (c : cs)
              in Num (read ds) : (tokens rs)
            | isSpace c = tokens cs
            | otherwise = Error "unknown token"
   |
38 |                             in Num(read ds):(tokens rs)
   |                                ^^^^^^^^^^^^^^^^^^^^^^^^

calc_final2.hs:38:46: error:
    ? Couldn't match expected type ‘[Token]’
                  with actual type ‘MayError [Token]’
    ? In the second argument of ‘(:)’, namely ‘(tokens rs)’
      In the expression: Num (read ds) : (tokens rs)
      In the expression:
        let (ds, rs) = span isDigit (c : cs) in Num (read ds) : (tokens rs)
   |
38 |                             in Num(read ds):(tokens rs)
   |                                              ^^^^^^^^^

calc_final2.hs:56:38: error:
    ? Couldn't match expected type ‘(a, b)’
                  with actual type ‘MayError (ParseTree, [Token])’
    ? In the expression: parseFactor l
      In a pattern binding: (p1, l1) = parseFactor l
      In the expression:
        let (p1, l1) = parseFactor l in (Minus (Number 0) p1, l1)
    ? Relevant bindings include
        p1 :: a (bound at calc_final2.hs:56:28)
        l1 :: b (bound at calc_final2.hs:56:32)
   |
56 | parseFactor (Sub:l) = let (p1, l1) = parseFactor l in (Minus (Number 0) p1, l1)
   |                                      ^^^^^^^^^^^^^

calc_final2.hs:56:55: error:
    ? Couldn't match expected type ‘MayError (ParseTree, [Token])’
                  with actual type ‘(ParseTree, b0)’
    ? In the expression: (Minus (Number 0) p1, l1)
      In the expression:
        let (p1, l1) = parseFactor l in (Minus (Number 0) p1, l1)
      In an equation for ‘parseFactor’:
          parseFactor (Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Since the return type of tokens is MayError [Token], you need to wrap the items in a Value, for items where we recurse, we can perform an fmap to prepend to the list wrapped in the Value:

tokens :: String -> MayError [Token]
tokens [] = Value []
tokens ('+':cs) = (Add:) <$> tokens cs
tokens ('-':cs) = (Sub:) <$> tokens cs
tokens ('*':cs) = (Mul:) <$> tokens cs
tokens ('/':cs) = (Div:) <$> tokens cs
tokens ('(':cs) = (LPar:) <$>  tokens cs
tokens (')':cs) = (RPar:) <$>  tokens cs
tokens ('^':cs) = (Exp:) <$>  tokens cs
tokens (c:cs) | isDigit c = let (ds,rs) = span isDigit (c:cs)
                            in (Num (read ds):) <$> tokens rs
              | isSpace c = tokens cs
              | otherwise = Error "unknown token"

Other functions have the same problem: you should wrap values in a Value data constructor, or unwrap these if you are processing a MayError value.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...