Here is my data structure
data Ex =
P String
| (:←) Ex
It has the property that p == ←←p. My custom Eq and Ord instances attempt to define the same. However, I am seeing inconsistent results for test3 (set created from [p,←←p, ←p]) and test4 (set created from [p, ←p, ←←p]). Results as shown below:
*Test> test3
fromList [←q,←←q]
*Test> test4
fromList [q,←q,←←q]
Note that test3 and test4 only differ in the order of the elements from which the set is created. Yet, the results differ.
I think the order of the set creation using Data.Set.fromList should not really matter. Can someone help me find the mistake with my Eq or Ord instance? Full code below, compiled with GHC 8.4.3.
module Test where
import Data.Set as S
data Ex =
P String
| (:←) Ex
instance Show Ex where
show (P s) = s
show ((:←) e) = "←" ++ (show e)
instance Eq Ex where
(P s1) == (P s2) = s1 == s2
(:←) e1 == (:←) e2
| e1 == e2 = True
| otherwise = False
e1 == (:←) e2
| e1 == e2 = False
| (:←) e1 == e2 = True
| otherwise = False
(:←) e1 == e2
| e1 == e2 = False
| e1 == (:←) e2 = True
| otherwise = False
elength :: Ex -> Int
elength (P s) = length s
elength ((:←) e) = elength e + 1
instance Ord Ex where
compare e1 e2
| e1 == e2 = EQ
| otherwise = if (elength e1) <= (elength e2) then LT
else GT
-- Check that ←q == ←←q
test2 = S.fromList [(:←) ((:←) (P "q")), P "q"]
-- output should be : {←←q, ←q}
test3 = S.fromList [P "q", (:←) ((:←) (P "q")), (:←) (P "q")]
-- output should be same as that of test3 : {←←q, ←q}
test4 = S.fromList [P "q", (:←) (P "q"), (:←) ((:←) (P "q"))]
EDIT:
Note that if I modify the elength definition to handle the case, the inconsistency is gone.
elength ((:←) ((:←) e)) = elength e
Perhaps my elength metric and == definitions are at odds in the case of q and ←←q. I would still like to know where exactly they are going wrong
Your Eq instance certainly looks strange to me. I would unravel the cancelled-out pairings two at a time, rather than piecemeal:
instance Eq Ex where
(P s1) == (P s2) = s1 == s2
((:←) e1) == (:←) e2 = e1 == e2
e1 == (:←) ((:←) e2) = e1 == e2
(:←) ((:←) e1) == e2 = e1 == e2
_ == _ = False
Maybe this is equivalent to what you have written; it is rather hard to tell because your pattern-matching does not align well with your goals.
Your Ord instance is also a problem, because you do not define a consistent ordering. For any set of items x y z, where x < y && y < z, it should be the case that x < z. However, there are easy counterexamples according to your rules:
x = P "a"
y = (P "b" :←)
z = ((P "a" :←) :←)
Here x == z despite y being in between them.
One way to fix both problems is to write a simplify function that removes all pairs of cancelling-out constructors, and use that in both Eq and Ord instances. Simplify each argument, so that you know they each have either 0 or 1 levels of negation. From there, Eq is easy, and all you need to do before you can define Ord is to decide whether a negated value should be less than or greater than a non-negated value. You can't choose for them to be equal, because that again breaks transitivity.
If you do write simplify, it will be a lot of wasted work to call simplify every time you touch one of these objects, since you immediately throw away the simplification. I'd choose not to export the constructor for this type, and instead offer a smart constructor that simplifies before returning a value. Then consumers will know everything is negated once or not at all.
Related
this is an exercise where I have to create my own universe of things in Haskell for a logic course. This was given to us already:
data Thing = A | B | C | D | E deriving (Eq,Show)
things :: [Thing]
things = [ A, B, C, D, E ]
data Colour = Amber | Blue deriving Eq
colour :: Thing -> Colour
colour A = Amber
colour B = Amber
colour C = Amber
colour D = Blue
colour E = Amber
data Shape = Square | Disc deriving Eq
shape :: Thing -> Shape
shape A = Square
shape B = Square
shape C = Disc
shape D = Square
shape E = Square
data Size = Big | Small deriving Eq
size :: Thing -> Size
size A = Big
size B = Big
size C = Big
size D = Big
size E = Small
data Border = Thin | Thick deriving Eq
border :: Thing -> Border
border A = Thick
border B = Thin
border C = Thick
border D = Thick
border E = Thick
type Predicate u = u -> Bool
isAmber :: Predicate Thing
isAmber x = colour x == Amber
isBlue :: Predicate Thing
isBlue x = colour x == Blue
isSquare :: Predicate Thing
isSquare x = shape x == Square
isDisc :: Predicate Thing
isDisc x = shape x == Disc
isBig :: Predicate Thing
isBig x = size x == Big
isSmall :: Predicate Thing
isSmall x = size x == Small
hasThinBorder :: Predicate Thing
hasThinBorder x = border x == Thin
hasThickBorder :: Predicate Thing
hasThickBorder x = border x == Thick
The following function was also given as an example of predicate negation :
neg :: Predicate u -> Predicate u
(neg a) x = not (a x)
I have to write 2 functions, one for conjunction (only true & true = true, all else is false) and disjunction (only false & false = true). I was pretty sure that this was correct, but i get the prelude undefined error when I call:
(|:|) :: Predicate u -> Predicate u -> Predicate u
(a |:| b) x = (a x) && (b x)
(&:&) :: Predicate u -> Predicate u -> Predicate u
(a &:& b) x = (a x) || (b x)
(|=) :: Predicate Thing -> Predicate Thing -> Bool
a |= b = [thinga | thinga <- things, a thinga] == [thingb | thingb <- things, b thingb, a thingb]
(|/=) :: Predicate Thing -> Predicate Thing -> Bool
a |/= b = not (a |= b)
But also, the instructions say that calling the following should work, and i do not understand how, since the x formal parameter is never used...
isBig &:& isAmber |= isDisc
That should return either true or false apparently
Example of Error
*Main> :reload
Ok, one module loaded.
*Main> isSmall |= isDisc
False
*Main> (neg isAmber) C
False
*Main> (isBig &:& isAmber) |= isDisc
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries\base\GHC\Err.hs:79:14 in base:GHC.Err
undefined, called at things.hs:89:15 in main:Main
I'm focusing on this part:
and i do not understand how, since the x formal parameter is never
used...
isBig &:& isAmber |= isDisc
That should return either true or false apparently
The value of x is chosen by |=, which will call both predicates isBig &:& isAmber and isDisc with all the x in list things.
Expanding the definitions:
isBig &:& isAmber |= isDisc
= -- according to the definition of |=
[thinga | thinga <- things, (isBig &:& isAmber) thinga]
==
[thingb | thingb <- things, isDisc thingb, (isBig &:& isAmber) thingb]
= -- according to the definition of &:&
[thinga | thinga <- things, isBig thinga && isAmber thinga]
==
[thingb | thingb <- things, isDisc thingb, isBig thingb && isAmber thingb]
=
[ A, B, C ] -- i.e., list of all things which are both big and amber
==
[ C ] -- i.e., list of all things which are discs, big, and amber
=
False -- the two lists are not the same list
So, it's thinga and thingb that are passed as x. Those variables, in turn, assume all the values inside the list things, i.e. [A,B,C,D,E].
My situation:
In my code, a value xID seems to be variable in case ~ of structure.
import Debug.Trace
data I = I
{ iID :: Int } deriving Show
data C = C
{ i :: I} deriving Show
x = I 0
aC2 = C (I 2)
aC3 = C (I 3)
aC5 = C (I 5)
xID = iID x
cConverter aC =
trace ((show cIID) ++ (if cIID == xID then "==" else "/=") ++ (show xID) ++ " when " ++ (show x)) $
"Point: " ++ pID
where
pID :: String
pID =
case cIID of
xID -> trace ((show cIID) ++ (if cIID == xID then "==" else "/=") ++ (show xID) ++ " when " ++ (show x)) "X"
_ -> show cIID
cIID = iID . i $ aC
-- xID = iID x
What I expect
I expected that when I run cConverter aC2, I'll get "2" because 2 in aC2 = C (I 2) is not equal to 0 in x = I 0.
What happens
However, I've faced the strange result when I run cConvert aC2 like:
Main> cConverter aC2
"2/=0 when I {iID = 0}
Point: 2==2 when I {iID = 0}
X"
Why I get "X" instead of "2"?
More precisely, Why xID is 2 when cIID is 2, and xID is 3 when cIID is 3?
I think xID always be 0 in this code, but does xID means something other when I use this in the condition of the case?
Clear sample
Here is more clear code without debugging message
data I = I
{ iID :: Int } deriving Show
data C = C
{ i :: I} deriving Show
x = I 0
aC2 = C (I 2)
aC3 = C (I 3)
aC5 = C (I 5)
xID = iID x
cConverter aC =
"Point: " ++ pID
where
pID :: String
pID =
case cIID of
xID -> "X"
_ -> show cIID
cIID = iID . i $ aC
-- xID = iID x
Point 1
GHCi warns me like:
Bug.hs:22:7: Warning:
Pattern match(es) are overlapped
In a case alternative: _ -> ...
It seems to be xID overlaps _.
But why xID overlaps hole?
Anyway, I avoid this problem by using a guard instead of case.
However, I could not understand what happens with my code.
The case
case cIID of
xID -> ...
_ -> ...
introduces a new local variable named xID, which is unrelated to the global xID. Further, since it is a variable it catches everything: the branch _ -> ... will never be taken.
Use this instead:
case cIID of
xID' | xID' == xID -> ...
_ -> ...
or, more simply,
if cIID == xID
then ...
else ...
About "why" it works in this way:
Consider the code
foo :: Either Int String -> Int
foo e = case e of
Left x -> x
Right y -> length y
This is a nice total function: it will always return an Int whatever is the value of the argument e.
Now suppose I add to the code, much later on,
x :: Int
x = 42
This should NOT break foo! Yet, if the x in Left x is now interpreted to be 42, then function foo will crash on e.g. Left 43.
For this reason, pattern matching always introduces new variables, it never performs equality checks with pre-existing variables. To do that, use a guard like x | x == y -> ....
i have given two points.
Now of i need to check if those points are identical, so i do:
type datatypePoint = (Float,Float)
anyLine :: datatypePoint -> datatypePoint -> datatypeLine
anyLine a b = [[fst a, fst b] , [snd a, snd b]]
| (fst a == fst b) && (snd a == snd b) = error "Identical"
| otherwise = error "Not identical"
But i get error:
unexpected |
anybody could tell me why? What am i doing wrong?
You have a few errors here, first off, all types start with upper case letters in Haskell
type Point = (Float,Float)
anyLine :: Point -> Point -> Point
Next, pattern matching happens before the = sign.
anyLine (a1, a2) (b1, b2)
| a1 == b1 && a2 == b2 = error "Identical"
| otherwise = error "Not identical"
And with guards we omit the equality sign.
This could also just be
anyLine a b
| a == b = ...
| otherwise = ...
I think it's well worth the time to read a good Haskell tutorial to learn some of the basic concepts you're missing, I personally favor Learn You A Haskell.
You can specify a result or define cases; you can't do both at the same time.
anyLine :: datatypePoint -> datatypePoint -> datatypeLine
anyLine a b
| (fst a == fst b) && (snd a == snd b) = error "Identical"
| otherwise = error "Not identical"
Other folks have already answered the question, but I wanted to point out that this would be even simpler if you used "newtype" and "deriving"
newtype Point a = Point (a, a) deriving (Eq)
anyLine a b
| a == b = ....
| otherwise = ....
It also doesn't hurt to keep the type a generic, so now this will work for "Point"s of Floats, Ints, etc.
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.
I want to implement an imperative language interpreter in Haskell (for educational purposes). But it's difficult for me to create right architecture for my interpreter: How should I store variables? How can I implement nested function calls? How should I implement variable scoping? How can I add debugging possibilities in my language? Should I use monads/monad transformers/other techniques? etc.
Does anybody know good articles/papers/tutorials/sources on this subject?
If you are new to writing this kind of processors, I would recommend to put off using monads for a while and first focus on getting a barebones implementation without any bells or whistles.
The following may serve as a minitutorial.
I assume that you have already tackled the issue of parsing the source text of the programs you want to write an interpreter for and that you have some types for capturing the abstract syntax of your language. The language that I use here is very simple and only consists of integer expressions and some basic statements.
Preliminaries
Let us first import some modules that we will use in just a bit.
import Data.Function
import Data.List
The essence of an imperative language is that it has some form of mutable variables. Here, variables simply represented by strings:
type Var = String
Expressions
Next, we define expressions. Expressions are constructed from integer constants, variable references, and arithmetic operations.
infixl 6 :+:, :-:
infixl 7 :*:, :/:
data Exp
= C Int -- constant
| V Var -- variable
| Exp :+: Exp -- addition
| Exp :-: Exp -- subtraction
| Exp :*: Exp -- multiplication
| Exp :/: Exp -- division
For example, the expression that adds the constant 2 to the variable x is represented by V "x" :+: C 2.
Statements
The statement language is rather minimal. We have three forms of statements: variable assignments, while loops, and sequences.
infix 1 :=
data Stmt
= Var := Exp -- assignment
| While Exp Stmt -- loop
| Seq [Stmt] -- sequence
For example, a sequence of statements for "swapping" the values of the variables x and y can be represented by Seq ["tmp" := V "x", "x" := V "y", "y" := V "tmp"].
Programs
A program is just a statement.
type Prog = Stmt
Stores
Now, let us move to the actual interpreter. While running a program, we need to keep track of the values assigned to the different variables in the programs. These values are just integers and as a representation of our "memory" we just use lists of pairs consisting of a variable and a value.
type Val = Int
type Store = [(Var, Val)]
Evaluating expressions
Expressions are evaluated by mapping constants to their value, looking up the values of variables in the store, and mapping arithmetic operations to their Haskell counterparts.
eval :: Exp -> Store -> Val
eval (C n) r = n
eval (V x) r = case lookup x r of
Nothing -> error ("unbound variable `" ++ x ++ "'")
Just v -> v
eval (e1 :+: e2) r = eval e1 r + eval e2 r
eval (e1 :-: e2) r = eval e1 r - eval e2 r
eval (e1 :*: e2) r = eval e1 r * eval e2 r
eval (e1 :/: e2) r = eval e1 r `div` eval e2 r
Note that if the store contains multiple bindings for a variable, lookup selects the bindings that comes first in the store.
Executing statements
While the evaluation of an expression cannot alter the contents of the store, executing a statement may in fact result in an update of the store. Hence, the function for executing a statement takes a store as an argument and produces a possibly updated store.
exec :: Stmt -> Store -> Store
exec (x := e) r = (x, eval e r) : r
exec (While e s) r | eval e r /= 0 = exec (Seq [s, While e s]) r
| otherwise = r
exec (Seq []) r = r
exec (Seq (s : ss)) r = exec (Seq ss) (exec s r)
Note that, in the case of assignments, we simply push a new binding for the updated variable to the store, effectively shadowing any previous bindings for that variable.
Top-level Interpreter
Running a program reduces to executing its top-level statement in the context of an initial store.
run :: Prog -> Store -> Store
run p r = nubBy ((==) `on` fst) (exec p r)
After executing the statement we clean up any shadowed bindings, so that we can easily read off the contents of the final store.
Example
As an example, consider the following program that computes the Fibonacci number of the number stored in the variable n and stores its result in the variable x.
fib :: Prog
fib = Seq
[ "x" := C 0
, "y" := C 1
, While (V "n") $ Seq
[ "z" := V "x" :+: V "y"
, "x" := V "y"
, "y" := V "z"
, "n" := V "n" :-: C 1
]
]
For instance, in an interactive environment, we can now use our interpreter to compute the 25th Fibonacci number:
> lookup "x" $ run fib [("n", 25)]
Just 75025
Monadic Interpretation
Of course, here, we are dealing with a very simple and tiny imperative language. As your language gets more complex, so will the implementation of your interpreter. Think for example about what additions you need when you add procedures and need to distinguish between local (stack-based) storage and global (heap-based) storage. Returning to that part of your question, you may then indeed consider the introduction of monads to streamline the implementation of your interpreter a bit.
In the example interpreter above, there are two "effects" that are candidates for being captured by a monadic structure:
The passing around and updating of the store.
Aborting running the program when a run-time error is encountered. (In the implementation above, the interpreter simply crashes when such an error occurs.)
The first effect is typically captured by a state monad, the second by an error monad. Let us briefly investigate how to do this for our interpreter.
We prepare by importing just one more module from the standard libraries.
import Control.Monad
We can use monad transformers to construct a composite monad for our two effects by combining a basic state monad and a basic error monad. Here, however, we simply construct the composite monad in one go.
newtype Interp a = Interp { runInterp :: Store -> Either String (a, Store) }
instance Monad Interp where
return x = Interp $ \r -> Right (x, r)
i >>= k = Interp $ \r -> case runInterp i r of
Left msg -> Left msg
Right (x, r') -> runInterp (k x) r'
fail msg = Interp $ \_ -> Left msg
Edit 2018: The Applicative Monad Proposal
Since the Applicative Monad Proposal (AMP) every Monad must also be an instance of Functor and Applicative. To do this we can add
import Control.Applicative -- Otherwise you can't do the Applicative instance.
to the imports and make Interp an instance of Functor and Applicative like this
instance Functor Interp where
fmap = liftM -- imported from Control.Monad
instance Applicative Interp where
pure = return
(<*>) = ap -- imported from Control.Monad
Edit 2018 end
For reading from and writing to the store, we introduce effectful functions rd and wr:
rd :: Var -> Interp Val
rd x = Interp $ \r -> case lookup x r of
Nothing -> Left ("unbound variable `" ++ x ++ "'")
Just v -> Right (v, r)
wr :: Var -> Val -> Interp ()
wr x v = Interp $ \r -> Right ((), (x, v) : r)
Note that rd produces a Left-wrapped error message if a variable lookup fails.
The monadic version of the expression evaluator now reads
eval :: Exp -> Interp Val
eval (C n) = do return n
eval (V x) = do rd x
eval (e1 :+: e2) = do v1 <- eval e1
v2 <- eval e2
return (v1 + v2)
eval (e1 :-: e2) = do v1 <- eval e1
v2 <- eval e2
return (v1 - v2)
eval (e1 :*: e2) = do v1 <- eval e1
v2 <- eval e2
return (v1 * v2)
eval (e1 :/: e2) = do v1 <- eval e1
v2 <- eval e2
if v2 == 0
then fail "division by zero"
else return (v1 `div` v2)
In the case for :/:, division by zero results in an error message being produced through the Monad-method fail, which, for Interp, reduces to wrapping the message in a Left-value.
For the execution of statements we have
exec :: Stmt -> Interp ()
exec (x := e) = do v <- eval e
wr x v
exec (While e s) = do v <- eval e
when (v /= 0) (exec (Seq [s, While e s]))
exec (Seq []) = do return ()
exec (Seq (s : ss)) = do exec s
exec (Seq ss)
The type of exec conveys that statements do not result in values but are executed only for their effects on the store or the run-time errors they may trigger.
Finally, in the function run we perform a monadic computation and process its effects.
run :: Prog -> Store -> Either String Store
run p r = case runInterp (exec p) r of
Left msg -> Left msg
Right (_, r') -> Right (nubBy ((==) `on` fst) r')
In the interactive environment, we can now revisit the interpretation of our example program:
> lookup "x" `fmap` run fib [("n", 25)]
Right (Just 75025)
> lookup "x" `fmap` run fib []
Left "unbound variable `n'"
A couple of good papers I've finally found:
Building Interpreters by Composing Monads
Monad Transformers Step by Step - how incrementally build tiny interpreter using
monad transformers
How to build a monadic interpreter in one day
Monad Transformers and Modular Interpreters