I want to implement a method for showing a propositional formula in SML. The solutions that I found so far was of this type:
fun show (Atom a) = a
| show (Neg p) = "(~ " ^ show p ^ ")"
| show (Conj(p,q)) = "(" ^ show p ^ " & " ^ show q ^ ")"
| show (Disj(p,q)) = "(" ^ show p ^ " | " ^ show q ^ ")";
This produces unnecessary braces:
((~p) & (q | r))
when, what I'd like to have is:
~ p & (q | r)
I saw, that Haskell has a function (display?) which does this nicely. Can someone help me out a little bit. How should I go about this?
If you want to eliminate redundant parentheses, you will need to pass around some precedence information. For example, in Haskell, the showsPrec function embodies this pattern; it has type
showsPrec :: Show a => Int -> a -> String -> String
where the first Int argument is the precedence of the current printing context. The extra String argument is a trick to get efficient list appending. I'll demonstrate how to write a similar function for your type, though admittedly in Haskell (since I know that language best) and without using the extra efficiency trick.
The idea is to first build a string that has no top-level parentheses -- but does have all the parentheses needed to disambiguate subterms -- then add parentheses only if necessary. The unbracketed computation below does the first step. Then the only question is: when should we put parentheses around our term? Well, the answer to that is that things should be parenthesized when a low-precedence term is an argument to a high-precedence operator. So we need to compare the precedence of our immediate "parent" -- called dCntxt in the code below -- to the precedence of the term we're currently rendering -- called dHere in the code below. The bracket function below either adds parentheses or leaves the string alone based on the result of this comparison.
data Formula
= Atom String
| Neg Formula
| Conj Formula Formula
| Disj Formula Formula
precedence :: Formula -> Int
precedence Atom{} = 4
precedence Neg {} = 3
precedence Conj{} = 2
precedence Disj{} = 1
displayPrec :: Int -> Formula -> String
displayPrec dCntxt f = bracket unbracketed where
dHere = precedence f
recurse = displayPrec dHere
unbracketed = case f of
Atom s -> s
Neg p -> "~ " ++ recurse p
Conj p q -> recurse p ++ " & " ++ recurse q
Disj p q -> recurse p ++ " | " ++ recurse q
bracket
| dCntxt > dHere = \s -> "(" ++ s ++ ")"
| otherwise = id
display :: Formula -> String
display = displayPrec 0
Here's how it looks in action.
*Main> display (Neg (Conj (Disj (Conj (Atom "a") (Atom "b")) (Atom "c")) (Conj (Atom "d") (Atom "e"))))
"~ ((a & b | c) & d & e)"
Related
I am trying to write a function which outputs all variable names. When used on the example below, the output should be
*Main> used example
["a","b","x","y"]
This is what I have written so far...
import Data.Char
import Data.List
type Var = String
data Term =
Variable Var
| Lambda Var Term
| Apply Term Term
-- deriving Show
instance Show Term where
show = pretty
example :: Term
example = Lambda "a" (Lambda "x" (Apply (Apply (Lambda "y" (Variable "a")) (Variable "x")) (Variable "b")))
pretty :: Term -> String
pretty = f 0
where
f i (Variable x) = x
f i (Lambda x m) = if i /= 0 then "(" ++ s ++ ")" else s where s = "\\" ++ x ++ ". " ++ f 0 m
f i (Apply n m) = if i == 2 then "(" ++ s ++ ")" else s where s = f 1 n ++ " " ++ f 2 m
used :: Term -> [Var]
used (Variable n) = [n]
used (Lambda n t) = "\\" ++ n ++ ". " ++ used t
used (Apply t1 t2) = used t1 ++ used t2
The problem lies in the line used (Lambda n t) = "\\" ++ n ++ ". " ++ used t, I get this error message:
list.hs:28:47: error:
lexical error in string/character literal at character '\n'
|
28 | used (Lambda n t) = "\" ++ n ++ ". " ++ used t
Why am I getting this complaint?
You are copying and pasting from examples too much. Keep thinking about what the function is supposed to mean as you are writing it.
used (Variable n) = [n]
This is correct: the set of variables used in a term which is just a variable is the variable used. For example, the set of variables used in the term x is just [x].
used (Apply t1 t2) = used t1 ++ used t2
This is also correct1: the set of variables used in say (x y z) (w x y) is the union of the variables used in x y z and in w x y: that is [x,y,z,w,x,y].
So now let's consider the case you are struggling with.
used (Lambda n t) = ...
The code you have seems to be attempting to print the the term into a string, which is not what we are trying to do here -- we are trying to find the set of used variables.
Let's consider an example: we have a term like (\x. x y z), and we want to find out what its used variables are. Before trying to come up with the general solution, ask yourself what the result should be in this example.
If this function is going to be nicely recursive, can we express your expected result in terms of the used variables of x y z? How do we transform the set of used variables of x y z into the set of used variables of \x. x y z?
1 Though you might get duplicates.
I'm trying to convert a Haskell function, which displays a boolean formula, to a SML function.
The function:
data Formula
= Atom String
| Neg Formula
| Conj Formula Formula
| Disj Formula Formula
precedence :: Formula -> Int
precedence Atom{} = 4
precedence Neg {} = 3
precedence Conj{} = 2
precedence Disj{} = 1
displayPrec :: Int -> Formula -> String
displayPrec dCntxt f = bracket unbracketed where
dHere = precedence f
recurse = displayPrec dHere
unbracketed = case f of
Atom s -> s
Neg p -> "~ " ++ recurse p
Conj p q -> recurse p ++ " & " ++ recurse q
Disj p q -> recurse p ++ " | " ++ recurse q
bracket
| dCntxt > dHere = \s -> "(" ++ s ++ ")"
| otherwise = id
display :: Formula -> String
display = displayPrec 0
I' ve come so far as translating it to SML:
fun precedence(operator) =
case operator of
Atom a => 4
| Neg p => 3
| Conj(p,q) => 2
| Disj(p,q) => 1
fun displayPrec dCntxt f =
let
val dHere = precedence f
val recurse = displayPrec dHere
val unbracketed = case f of
Atom a => a
| Neg p => "~ " ^ recurse p
| Conj(p,q)=>(recurse p) ^ " & " ^ (recurse q)
| Disj(p,q)=>(recurse p) ^ " | " ^ (recurse q)
(* missing bracket function *)
in
(* bracket *) unbracketed
end
The unbracketed function works. It shows the formula without braces. The only thing that is still missing is the bracket function, which I don't know what it does and how to translate it to SML. Can someone, who is more experienced, help me with this?
That would be
val bracket =
if dCntxt > dHere
then fn s => "(" ^ s ^ ")"
else fn x => x
The function compares the precedence level of your context against the precedence level of the outer operator of your expression and decides to either insert a pair of parentheses around the given string or not.
How can one create LaTeX source for natural deduction proof trees (like those shown here) via Haskell eg using HaTeX? I'd like to emulate LaTeX .stys like bussproofs.sty or proof.sty.
I'm using your question as an excuse to improve and demo a Haskell
call-tracing library I'm working
on. In the context of
tracing, an obvious way to create a proof tree is to trace a type
checker and then format the trace as a natural-deduction proof. To
keep things simple my example logic is the simply-typed lambda
calculus
(STLC),
which corresponds to the implicational fragment of propositional
intuitionistic
logic.
I am using proofs.sty, but not via HaTeX or any other Haskell
Latex library. The Latex for proof trees is very simple and using a
Haskell Latex library would just complicate things.
I've written the proof-tree generation code twice:
in a self-contained way, by writing a type checker that also
returns a proof tree;
using my tracing library, by call-tracing a type checker and then
post processing the trace into a proof tree.
Since you didn't ask about call-tracing libraries, you may be less
interested in the call-trace based version, but I think it's
interesting to compare both versions.
Examples
Let's start with some output examples first, to see what all this gets us.
The first three examples are motivated
by an axiom system for implicational propositional
calculus;
the first two also happen to correspond to S and
K:
The first axiom, K, with proof terms:
The second axiom, S, with proof terms, but with premises in the
context, not lambda bound:
The fourth axiom, modus ponens, without proof terms:
The third axiom in that Wikipedia article (Peirce's law) is
non-constructive and so we can't prove it here.
For a different kind of example, here's a failed type check of the Y
combinator:
The arrows are meant to lead you to the error, which is marked with a
bang (!).
Code
Now I'll describe the code which generated those examples. The code is
from this
file
unless otherwise noted. I'm not including every line of code here;
see that link if you want something you can actually build using GHC
7.6.3.
Most of the code -- the grammar, parser, and pretty printer -- is the
same for both versions; only the type checkers and proof-tree
generators differ. All of the common code is in the file just
referenced.
STLC grammar
The STLC grammar in ASCII:
-- Terms
e ::= x | \x:T.e | e e
-- Types
T ::= A | T -> T
-- Contexts
C ::= . | C,x:T
And the corresponding Haskell:
type TmVar = String
type TyVar = String
data Tm = Lam TmVar Ty Tm
| TmVar TmVar
| Tm :#: Tm
deriving Show
data Ty = TyVar TyVar
| Ty :->: Ty
deriving (Eq , Show)
type Ctx = [(TmVar,Ty)]
Type checking + proof tree generation
Both versions implement the same abstract STLC type checker. In ASCII:
(x:T) in C
---------- Axiom
C |- x : T
C,x:T1 |- e : T2
--------------------- -> Introduction
C |- \x:T1.e : T1->T2
C |- e : T1 -> T2 C |- e1 : T1
--------------------------------- -> Elimination
C |- e e1 : T2
Version 1: self-contained with inline proof-tree generation
The full code for this version is
here.
The proof-tree generation happens in the type checker, but the actual
proof-tree generation code is factored out into addProof and
conclusion.
Type checking
-- The mode is 'True' if proof terms should be included.
data R = R { _ctx :: Ctx , _mode :: Bool }
type M a = Reader R a
extendCtx :: TmVar -> Ty -> M a -> M a
extendCtx x t = local extend where
extend r = r { _ctx = _ctx r ++ [(x,t)] }
-- These take the place of the inferred type when there is a type
-- error.
here , there :: String
here = "\\,!"
there = "\\,\\uparrow"
-- Return the inferred type---or error string if type inference
-- fails---and the latex proof-tree presentation of the inference.
--
-- This produces different output than 'infer' in the error case: here
-- all premises are always computed, whereas 'infer' stops at the
-- first failing premise.
inferProof :: Tm -> M (Either String Ty , String)
inferProof tm#(Lam x t e) = do
(et' , p) <- extendCtx x t . inferProof $ e
let et'' = (t :->:) <$> et'
addProof et'' [p] tm
inferProof tm#(TmVar x) = do
mt <- lookup x <$> asks _ctx
let et = maybe (Left here) Right mt
addProof et [] tm
inferProof tm#(e :#: e1) = do
(et , p) <- inferProof e
(et1 , p1) <- inferProof e1
case (et , et1) of
(Right t , Right t1) ->
case t of
t1' :->: t2 | t1' == t1 -> addProof (Right t2) [p , p1] tm
_ -> addProof (Left here) [p , p1] tm
_ -> addProof (Left there) [p , p1] tm
Proof tree generation
The addProof corresponds to proofTree in the other version:
-- Given the inferred type, the proof-trees for all premise inferences
-- (subcalls), and the input term, annotate the inferred type with a
-- result proof tree.
addProof :: Either String Ty -> [String] -> Tm -> M (Either String Ty , String)
addProof et premises tm = do
R { _mode , _ctx } <- ask
let (judgment , rule) = conclusion _mode _ctx tm et
let tex = "\\infer[ " ++ rule ++ " ]{ " ++
judgment ++ " }{ " ++
intercalate " & " premises ++ " }"
return (et , tex)
The code for conclusion is common to both versions:
conclusion :: Mode -> Ctx -> Tm -> Either String Ty -> (String , String)
conclusion mode ctx tm e = (judgment mode , rule tm)
where
rule (TmVar _) = "\\textsc{Axiom}"
rule (Lam {}) = "\\to \\text{I}"
rule (_ :#: _) = "\\to \\text{E}"
tyOrError = either id pp e
judgment True = pp ctx ++ " \\vdash " ++ pp tm ++ " : " ++ tyOrError
judgment False = ppCtxOnlyTypes ctx ++ " \\vdash " ++ tyOrError
Version 2: via call-tracing, with proof-tree generation as post processing
Here the type checker is not even aware of proof-tree generation, and
adding call-tracing is just one line.
Type checking
type Mode = Bool
type Stream = LogStream (ProofTree Mode)
type M a = ErrorT String (ReaderT Ctx (Writer Stream)) a
type InferTy = Tm -> M Ty
infer , infer' :: InferTy
infer = simpleLogger (Proxy::Proxy "infer") ask (return ()) infer'
infer' (TmVar x) = maybe err pure . lookup x =<< ask where
err = throwError $ "Variable " ++ x ++ " not in context!"
infer' (Lam x t e) = (t :->:) <$> (local (++ [(x,t)]) . infer $ e)
infer' (e :#: e1) = do
t <- infer e
t1 <- infer e1
case t of
t1' :->: t2 | t1' == t1 -> pure t2
_ -> throwError $ "Can't apply " ++ show t ++ " to " ++ show t1 ++ "!"
The LogStream
type
and ProofTree
class
are from the library. The LogStream is the type of log events that
the "magic"
simpleLogger
logs. Note the line
infer = simpleLogger (Proxy::Proxy "infer") ask (return ()) infer'
which defines infer to be a logged version of infer', the actual
type checker. That's all you have to do to trace a monadic function!
I won't get into how simpleLogger actually works here, but the
result is that each call to infer gets logged, including the
context, arguments, and return value, and these data get grouped
together with all logged subcalls (here only to infer). It would be
easy to manually write such logging code for infer, but it's nice
that with the library you don't have to.
Proof-tree generation
To generate the Latex proof trees, we implement ProofTree to post
process infer's call trace. The library provides a proofTree
function that calls the ProofTree methods and assembles the proof
trees; we just need to specify how the conclusions of the typing
judgments will be formatted:
instance ProofTree Mode (Proxy (SimpleCall "infer" Ctx InferTy ())) where
callAndReturn mode t = conclusion mode ctx tm (Right ty)
where
(tm , ()) = _arg t
ty = _ret t
ctx = _before t
callAndError mode t = conclusion mode ctx tm (Left error)
where
(tm , ()) = _arg' t
how = _how t
ctx = _before' t
error = maybe "\\,!" (const "\\,\\uparrow") how
The pp calls are to a user defined pretty printer; obviously, the
library can't know how to pretty print your data types.
Because calls can be erroneous -- the library detects errors
-- we have to say how to format
successful and failing calls. Refer to the Y-combinator example above
for an example a failing type check, corresponding to the
callAndError case here.
The library's proofTree
function
is quite simple: it builds a proofs.sty proof tree with the current
call as conclusion, and the subcalls as premises:
proofTree :: mode -> Ex2T (LogTree (ProofTree mode)) -> String
proofTree mode (Ex2T t#(CallAndReturn {})) =
"\\infer[ " ++ rule ++ " ]{ " ++ conclusion ++ " }{ " ++ intercalate " & " premises ++ " }"
where
(conclusion , rule) = callAndReturn mode t
premises = map (proofTree mode) (_children t)
proofTree mode (Ex2T t#(CallAndError {})) =
"\\infer[ " ++ rule ++ " ]{ " ++ conclusion ++ " }{ " ++ intercalate " & " premises ++ " }"
where
(conclusion , rule) = callAndError mode t
premises = map (proofTree mode)
(_children' t ++ maybe [] (:[]) (_how t))
I use proofs.sty in the library because it allows arbitrarily many
premises, although bussproofs.sty would work for this STLC example
since no rule has more than five premises (the limit for
bussproofs). Both Latex packages are described
here.
Pretty printing
Now we return to code that is common between both versions.
The pretty printer that defines the pp used above is rather long --
it handles precedence and associativity, and is written in a way that
should be extensible if more terms, e.g. products, are added to the
calculus -- but mostly straightforward. First, we set up a precedence
table and a precedence-and-associativity-aware parenthesizer:
- Precedence: higher value means tighter binding.
type Prec = Double
between :: Prec -> Prec -> Prec
between x y = (x + y) / 2
lowest , highest , precLam , precApp , precArr :: Prec
highest = 1
lowest = 0
precLam = lowest
precApp = between precLam highest
precArr = lowest
-- Associativity: left, none, or right.
data Assoc = L | N | R deriving Eq
-- Wrap a pretty print when the context dictates.
wrap :: Pretty a => Assoc -> a -> a -> String
wrap side ctx x = if prec x `comp` prec ctx
then pp x
else parens . pp $ x
where
comp = if side == assoc x || assoc x == N
then (>=)
else (>)
parens s = "(" ++ s ++ ")"
And then we define the individual pretty printers:
class Pretty t where
pp :: t -> String
prec :: t -> Prec
prec _ = highest
assoc :: t -> Assoc
assoc _ = N
instance Pretty Ty where
pp (TyVar v) = v
pp t#(t1 :->: t2) = wrap L t t1 ++ " {\\to} " ++ wrap R t t2
prec (_ :->: _) = precArr
prec _ = highest
assoc (_ :->: _) = R
assoc _ = N
instance Pretty Tm where
pp (TmVar v) = v
pp (Lam x t e) = "\\lambda " ++ x ++ " {:} " ++ pp t ++ " . " ++ pp e
pp e#(e1 :#: e2) = wrap L e e1 ++ " " ++ wrap R e e2
prec (Lam {}) = precLam
prec (_ :#: _) = precApp
prec _ = highest
assoc (_ :#: _) = L
assoc _ = N
instance Pretty Ctx where
pp [] = "\\cdot"
pp ctx#(_:_) =
intercalate " , " [ x ++ " {:} " ++ pp t | (x,t) <- ctx ]
By adding a "mode" argument, it would be easy to use the same pretty
printer to print plain ASCII, which would be useful with other
call-trace post processors, such as the (unfinished) UnixTree
processor.
Parsing
A parser is not essential to the example, but of course I did not enter the
example input terms directly as Haskell Tms.
Recall the STLC grammar in ASCII:
-- Terms
e ::= x | \x:T.e | e e
-- Types
T ::= A | T -> T
-- Contexts
C ::= . | C,x:T
This grammar is ambiguous: both the term application e e
and function type T -> T have no associativity given by the
grammar. But in STLC term application is left associative and function
types are right associative, and so the corresponding disambiguated
grammar we actually parse is
-- Terms
e ::= e' | \x:T.e | e e'
e' ::= x | ( e )
-- Types
T ::= T' | T' -> T
T' ::= A | ( T )
-- Contexts
C ::= . | C,x:T
The parser is maybe too simple -- I'm not using a languageDef and
it's whitespace sensitive -- but it gets the job done:
type P a = Parsec String () a
parens :: P a -> P a
parens = Text.Parsec.between (char '(') (char ')')
tmVar , tyVar :: P String
tmVar = (:[]) <$> lower
tyVar = (:[]) <$> upper
tyAtom , arrs , ty :: P Ty
tyAtom = parens ty
<|> TyVar <$> tyVar
arrs = chainr1 tyAtom arrOp where
arrOp = string "->" *> pure (:->:)
ty = arrs
tmAtom , apps , lam , tm :: P Tm
tmAtom = parens tm
<|> TmVar <$> tmVar
apps = chainl1 tmAtom appOp where
appOp = pure (:#:)
lam = uncurry Lam <$> (char '\\' *> typing)
<*> (char '.' *> tm)
tm = apps <|> lam
typing :: P (TmVar , Ty)
typing = (,) <$> tmVar
<*> (char ':' *> ty)
ctx :: P Ctx
ctx = typing `sepBy` (char ',')
To clarify what the input terms look like, here are the examples from
the Makefile:
# OUTFILE CONTEXT TERM
./tm2latex.sh S.ctx 'x:P->Q->R,y:P->Q,z:P' 'xz(yz)'
./tm2latex.sh S.lam '' '\x:P->Q->R.\y:P->Q.\z:P.xz(yz)'
./tm2latex.sh S.err '' '\x:P->Q->R.\y:P->Q.\z:P.xzyz'
./tm2latex.sh K.ctx 'x:P,y:Q' 'x'
./tm2latex.sh K.lam '' '\x:P.\y:Q.x'
./tm2latex.sh I.ctx 'x:P' 'x'
./tm2latex.sh I.lam '' '\x:P.x'
./tm2latex.sh MP.ctx 'x:P,y:P->Q' 'yx'
./tm2latex.sh MP.lam '' '\x:P.\y:P->Q.yx'
./tm2latex.sh ZERO '' '\s:A->A.\z:A.z'
./tm2latex.sh SUCC '' '\n:(A->A)->(A->A).\s:A->A.\z:A.s(nsz)'
./tm2latex.sh ADD '' '\m:(A->A)->(A->A).\n:(A->A)->(A->A).\s:A->A.\z:A.ms(nsz)'
./tm2latex.sh MULT '' '\m:(A->A)->(A->A).\n:(A->A)->(A->A).\s:A->A.\z:A.m(ns)z'
./tm2latex.sh Y.err '' '\f:A->A.(\x:A.f(xx))(\x:A.f(xx))'
./tm2latex.sh Y.ctx 'a:A->(A->A),y:(A->A)->A' '\f:A->A.(\x:A.f(axx))(y(\x:A.f(axx)))'
Latex document generation
The ./tm2latex.sh script just calls pdflatex on the output of the
Haskell programs described above. The Haskell programs produce the proof
tree and then wrap it in a minimal Latex document:
unlines
[ "\\documentclass[10pt]{article}"
, "\\usepackage{proof}"
, "\\usepackage{amsmath}"
, "\\usepackage[landscape]{geometry}"
, "\\usepackage[cm]{fullpage}"
-- The most slender font I could find:
-- http://www.tug.dk/FontCatalogue/iwonalc/
, "\\usepackage[light,condensed,math]{iwona}"
, "\\usepackage[T1]{fontenc}"
, "\\begin{document}"
, "\\tiny"
, "\\[" ++ tex ++ "\\]"
, "\\end{document}"
]
As you can see, most of the Latex is devoted to making the proof trees
as small as possible; I plan to also write an ASCII proof tree post
processor, which may be more useful in practice when the examples are
larger.
Conclusion
As always, it takes a bit of code to write a parser, type checker, and
pretty printer. On top of that, adding proof-tree generation is
pretty simple in both versions. This is a fun toy example, but I
expect to do something similar in the context of a "real"
unification-based type checker for a dependently-typed language; there
I expect call tracing and proof-tree generation (in ASCII) to provide
significant help in debugging the type checker.
This function generates simple .dot files for visualizing automata transition functions using Graphviz. It's primary purpose is debugging large sets of automatically generated transitions (e.g., the inflections of Latin verbs).
prepGraph :: ( ... ) => NFA c b a -> [String]
prepGraph nfa = "digraph finite_state_machine {"
: wrapSp "rankdir = LR"
: wrapSp ("node [shape = circle]" ++ (mapSp (states nfa \\ terminal nfa)))
: wrapSp ("node [shape = doublecircle]" ++ (mapSp $ terminal nfa))
: formatGraph nfa ++ ["}"]
formatGraph :: ( ... ) => NFA c b a -> [String]
formatGraph = map formatDelta . deltaTuples
where formatDelta (a, a', bc) = wrapSp (mkArrow a a' ++ " " ++ mkLabel bc)
mkArrow x y = show x ++ " -> " ++ show y
mkLabel (y, z) = case z of
(Just t) -> "[ label = \"(" ++ show y ++ ", " ++ show t ++ ")\" ]"
Nothing -> "[ label = \"(" ++ show y ++ ", " ++ "Null" ++ ")\" ]"
where wrap, wrapSp and mapSp are formatting functions, as is deltaTuples.
The problem is that formatGraph retains double quotes around Strings, which causes errors in Graphviz. E.g., when I print unlines $ prepGraph to a file, I get things like:
0 -> 1 [ label = "('a', "N. SF")" ];
instead of
0 -> 1 [ label = "('a', N. SF)" ];
(However, "Null" seems to work fine, and outputs perfectly well). Now of course the string "N. SF" isn't the actual form I use to store inflections, but that form does include a String or two. So how can I tell Haskell: when you show a String values, don't double-quote it?
Check out how Martin Erwig handled the same problem in Data.Graph.Inductive.Graphviz:
http://hackage.haskell.org/packages/archive/fgl/5.4.2.3/doc/html/src/Data-Graph-Inductive-Graphviz.html
The function you're looking for is "sq" at the bottom:
sq :: String -> String
sq s#[c] = s
sq ('"':s) | last s == '"' = init s
| otherwise = s
sq ('\'':s) | last s == '\'' = init s
| otherwise = s
sq s = s
(check out the context and adapt for your own code, of course)
Use dotgen package - it has special safeguards in place to prevent forbidden chars from sneaking into attribute values.
You could define your own typeClass like this:
class GShow a where
gShow :: a -> String
gShow = show
instance GShow String where
show = id
instance GShow Integer
instance GShow Char
-- And so on for all the types you need.
The default implementation for "gShow" is "show", so you don't need a "where" clause for every instance. But you do need all the instances, which is a bit of a drag.
Alternatively you could use overlapping instances. I think (although I haven't tried it) that this will let you replace the list of instances using the default "gShow" by a single line:
instance (Show a) => GShow a
The idea is that with overlapping instances the compiler will chose the most specific instance available. So for strings it will pick the string instance over the more general one, and for everything else the general one is the only one that matches.
It seems a little ugly, but you could apply a filter to show t
filter (/='"') (show t)
So I'm writing a program which returns a procedure for some given arithmetic problem, so I wanted to instance a couple of functions to Show so that I can print the same expression I evaluate when I test. The trouble is that the given code matches (-) to the first line when it should fall to the second.
{-# OPTIONS_GHC -XFlexibleInstances #-}
instance Show (t -> t-> t) where
show (+) = "plus"
show (-) = "minus"
main = print [(+),(-)]
returns
[plus,plus]
Am I just committing a mortal sin printing functions in the first place or is there some way I can get it to match properly?
edit:I realise I am getting the following warning:
Warning: Pattern match(es) are overlapped
In the definition of `show': show - = ...
I still don't know why it overlaps, or how to stop it.
As sepp2k and MtnViewMark said, you can't pattern match on the value of identifiers, only on constructors and, in some cases, implicit equality checks. So, your instance is binding any argument to the identifier, in the process shadowing the external definition of (+). Unfortunately, this means that what you're trying to do won't and can't ever work.
A typical solution to what you want to accomplish is to define an "arithmetic expression" algebraic data type, with an appropriate show instance. Note that you can make your expression type itself an instance of Num, with numeric literals wrapped in a "Literal" constructor, and operations like (+) returning their arguments combined with a constructor for the operation. Here's a quick, incomplete example:
data Expression a = Literal a
| Sum (Expression a) (Expression a)
| Product (Expression a) (Expression a)
deriving (Eq, Ord, Show)
instance (Num a) => Num (Expression a) where
x + y = Sum x y
x * y = Product x y
fromInteger x = Literal (fromInteger x)
evaluate (Literal x) = x
evaluate (Sum x y) = evaluate x + evaluate y
evaluate (Product x y) = evaluate x * evaluate y
integer :: Integer
integer = (1 + 2) * 3 + 4
expr :: Expression Integer
expr = (1 + 2) * 3 + 4
Trying it out in GHCi:
> integer
13
> evaluate expr
13
> expr
Sum (Product (Sum (Literal 1) (Literal 2)) (Literal 3)) (Literal 4)
Here's a way to think about this. Consider:
answer = 42
magic = 3
specialName :: Int -> String
specialName answer = "the answer to the ultimate question"
specialName magic = "the magic number"
specialName x = "just plain ol' " ++ show x
Can you see why this won't work? answer in the pattern match is a variable, distinct from answer at the outer scope. So instead, you'd have to write this like:
answer = 42
magic = 3
specialName :: Int -> String
specialName x | x == answer = "the answer to the ultimate question"
specialName x | x == magic = "the magic number"
specialName x = "just plain ol' " ++ show x
In fact, this is just what is going on when you write constants in a pattern. That is:
digitName :: Bool -> String
digitName 0 = "zero"
digitName 1 = "one"
digitName _ = "math is hard"
gets converted by the compiler to something equivalent to:
digitName :: Bool -> String
digitName x | x == 0 = "zero"
digitName x | x == 1 = "one"
digitName _ = "math is hard"
Since you want to match against the function bound to (+) rather than just bind anything to the symbol (+), you'd need to write your code as:
instance Show (t -> t-> t) where
show f | f == (+) = "plus"
show f | f == (-) = "minus"
But, this would require that functions were comparable for equality. And that is an undecidable problem in general.
You might counter that you are just asking the run-time system to compare function pointers, but at the language level, the Haskell programmer doesn't have access to pointers. In other words, you can't manipulate references to values in Haskell(*), only values themselves. This is the purity of Haskell, and gains referential transparency.
(*) MVars and other such objects in the IO monad are another matter, but their existence doesn't invalidate the point.
It overlaps because it treats (+) simply as a variable, meaning on the RHS the identifier + will be bound to the function you called show on.
There is no way to pattern match on functions the way you want.
Solved it myself with a mega hack.
instance (Num t) => Show (t -> t-> t) where
show op =
case (op 6 2) of
8 -> "plus"
4 -> "minus"
12 -> "times"
3 -> "divided"