{-# OPTIONS_HADDOCK hide #-}moduleData.Logic.Propositional.CorewhereimportPreludehiding(lookup)importControl.Monad(liftM,liftM2,replicateM)importData.Char(chr)importData.Functor((<$>))importData.List(group,sort)importData.Map(Map,fromList,lookup)importData.Maybe(fromMaybe)importTest.QuickCheck(Arbitrary,Gen,arbitrary,elements,oneof,sized)newtypeVar=VarCharderiving(Eq,Ord)instanceShowVarwhereshow(Varv)=[v]dataExpr=VariableVar|NegationExpr|ConjunctionExprExpr|DisjunctionExprExpr|ConditionalExprExpr|BiconditionalExprExprderivingEqinstanceShowExprwhereshow(Variablename)=shownameshow(Negationexpr)='¬':showexprshow(Conjunctionexp1exp2)=showBC"∧"exp1exp2show(Disjunctionexp1exp2)=showBC"∨"exp1exp2show(Conditionalexp1exp2)=showBC"→"exp1exp2show(Biconditionalexp1exp2)=showBC"↔"exp1exp2instanceArbitraryVarwherearbitrary=liftMVar.elements.mapchr$[65..90]++[97..122]instanceArbitraryExprwherearbitrary=randomExprrandomExpr::GenExprrandomExpr=sizedrandomExpr'randomExpr'::Int->GenExprrandomExpr'n|n>0=oneof[randomVar,randomNegboundedExpr,randomBinboundedExpr]|otherwise=randomVarwhereboundedExpr=randomExpr'(n`div`2)randomBin::GenExpr->GenExprrandomBinrExp=oneof.map(\c->liftM2crExprExp)$[Conjunction,Disjunction,Conditional,Biconditional]randomNeg::GenExpr->GenExprrandomNegrExp=Negation<$>rExprandomVar::GenExprrandomVar=Variable<$>arbitrarytypeMapping=MapVarBool-- | In order to interpret an expression, a mapping from variables to truth-- values needs to be provided. Truth values are compositional; that's to say,-- the value of a composite expression (any expression which is not atomic)-- depends on the truth values of its component parts. For example, the Haskell-- expression below would evaluate to @False@.---- > interpret-- > (Conjunction (Variable "A") (Variable "B"))-- > (fromList [("A", True), ("B", False)])interpret::Expr->Mapping->Boolinterpret(Variablev)vs=fromMaybeFalse(lookupvvs)interpret(Negationexpr)vs=not$interpretexprvsinterpret(Conjunctionexp1exp2)vs=interpretexp1vs&&interpretexp2vsinterpret(Disjunctionexp1exp2)vs=interpretexp1vs||interpretexp2vsinterpret(Conditionalexp1exp2)vs=not(interpretexp1vs)||interpretexp2vsinterpret(Biconditionalexp1exp2)vs=interpretexp1vs==interpretexp2vs-- | Generates the possible assignments of variables in an expression.assignments::Expr->[Mapping]assignmentsexpr=letvs=variablesexprps=replicateM(lengthvs)[True,False]inmap(fromList.zipvs)ps-- | Lists the names of variables present in an expression.variables::Expr->[Var]variablesexpr=letvars_(Variablev)vs=v:vsvars_(Negatione)vs=vars_evsvars_(Conjunctione1e2)vs=vars_e1vs++vars_e2vsvars_(Disjunctione1e2)vs=vars_e1vs++vars_e2vsvars_(Conditionale1e2)vs=vars_e1vs++vars_e2vsvars_(Biconditionale1e2)vs=vars_e1vs++vars_e2vsinmaphead.group.sort$vars_expr[]-- | Determines whether two expressions are extensionally equivalent (that is,-- have the same values under all interpretations).equivalent::Expr->Expr->Boolequivalentexp1exp2=valuesexp1==valuesexp2-- | Determines whether an expression is tautological.isTautology::Expr->BoolisTautology=and.values-- | Determines whether an expression is contradictory.isContradiction::Expr->BoolisContradiction=not.or.values-- | Determines whether an expression is contingent (that is, true in at least-- one interpretation and false in at least one interpretation).isContingent::Expr->BoolisContingentexpr=not(isTautologyexpr||isContradictionexpr)-- | Lists the values of an expression under all interpretations (that is, all-- assignments of values to variables).values::Expr->[Bool]valuesexpr=map(interpretexpr)(assignmentsexpr)-- | Represents expressions using only ASCII characters (the 'show' function-- pretty-prints expressions using logical symbols only present in extended-- character sets).showAscii::Expr->StringshowAscii(Variablename)=shownameshowAscii(Negationexpr)='~':showAsciiexprshowAscii(Conjunctionexp1exp2)=showBCA"&"exp1exp2showAscii(Disjunctionexp1exp2)=showBCA"|"exp1exp2showAscii(Conditionalexp1exp2)=showBCA"->"exp1exp2showAscii(Biconditionalexp1exp2)=showBCA"<->"exp1exp2showBinaryConnective::(Expr->String)->String->Expr->Expr->StringshowBinaryConnectiveshow_symbolexp1exp2='(':show_exp1++" "++symbol++" "++show_exp2++")"showBC::String->Expr->Expr->StringshowBC=showBinaryConnectiveshowshowBCA::String->Expr->Expr->StringshowBCA=showBinaryConnectiveshowAscii