<div dir="ltr"><div>Hello Cafe,<br> I am trying to write a parser for propositional logic[1]. It's working fine for every input except equivalence ( <=> ). <br><br><br>*Main> calculator "a=>b"<br>
Imp (Lit 'a') (Lit 'b')<br>*Main> calculator "a<=b"<br>Red (Lit 'a') (Lit 'b')<br>*Main> calculator "a<=>b"<br>*** Exception: failed to parse<br><br><br></div>
I think, the reason is parser taking equivalence ( <=> ) as reduction ( <= ) and next character is '>'  so it is parse error . If I remove both implication and reduction then equivalence is  working fine.<br>
<div><br>*Main> calculator "a<=>b"<br>Eqi (Lit 'a') (Lit 'b')<br><br>Could some please tell me how to solve this problem.  I also tried fixity declaration but got this error <br>LogicPraser.hs:12:10:<br>
    The fixity signature for `<=>' lacks an accompanying binding<br><br></div><div>-Mukesh Tiwari<br></div><div><br><br>[1] <a href="http://logic.stanford.edu/classes/cs157/2010/notes/chap02.html">http://logic.stanford.edu/classes/cs157/2010/notes/chap02.html</a><br>
<br><br>{-# LANGUAGE NoMonomorphismRestriction #-}<br>import Text.Parsec.Token<br>import Text.Parsec.Prim<br>import Text.Parsec.Char<br>import Text.Parsec.Expr<br>import Text.Parsec.Combinator<br>import Text.Parsec.Language<br>
import Control.Applicative hiding ( ( <|> ) , many )<br>import Data.Maybe ( fromJust )<br><br><br>--infixl 9 <=><br><br>data LExpr = Lit Char<br>           | Not LExpr<br>           | And LExpr LExpr<br>           | Or LExpr LExpr<br>
           | Imp LExpr LExpr  -- (=>)<br>           | Red LExpr LExpr  -- ( <= )<br>           | Eqi LExpr LExpr  -- ( <=> ) <br>           deriving Show<br><br>exprCal = buildExpressionParser table atom<br><br>
table = [  [ Prefix ( Not <$ string  "~"  ) ]<br>         , [ Infix  ( And <$ string  "&"  ) AssocLeft ]<br>         , [ Infix  ( Or  <$ string "|"   ) AssocLeft ]<br>         , [  Infix  ( Imp <$ string "=>"  ) AssocLeft  <br>
            , Infix  (  Red <$ string "<=" ) AssocLeft <br>            , Infix  ( Eqi <$ string "<=>" ) AssocLeft<br>           ]<br>        ]<br><br><br>atom =  char '(' *>  exprCal   <* char ')'<br>
     <|> ( Lit <$> letter )<br><br>calculator :: String -> LExpr<br>calculator expr = case parse  exprCal ""  expr of<br>                       Left msg -> error "failed to parse"<br>
                       Right ( val ) -> val<br>~                                             <br></div></div>