[Haskell-cafe] Elementary question about Type Constraints

lassoken lassoken at gmail.com
Mon Jul 9 09:41:30 EDT 2007


Hi,

I'm trying to translate Example 2.3.3 (simple symbolic differentation) from
Structure and Interpretation of Computer Programs into Haskell.

Here is code that works (as far as see):
---
data Term b = Var String | Const b | Sum (Term b) (Term b) | Prod (Term b)
(Term b)

newSum (Const a) (Const b) = Const (a+b)
newSum (Const 0) t at _ = t
newSum t at _ (Const 0) = t
newSum a b = Sum a b

newProd (Const a) (Const b) = Const (a*b)
newProd (Const 1) t at _ = t
newProd t at _ (Const 1) = t
newProd (Const 0) t at _ = Const 0
newProd t at _ (Const 0) = Const 0
newProd a b = Prod a b

deriv (Var x) (Const c) = Const 0
deriv (Var x) (Var y)
    | x == y = Const 1
    | otherwise = Const 0
deriv x@(Var _) (Sum u v) = newSum (deriv x u) (deriv x v)
deriv x@(Var _) (Prod u v) = newSum (newProd u (deriv x v)) (newProd (deriv
x u) v)

--instance Show (Term b) where show = showTerm
showTerm (Var x) = x
showTerm (Const c) = show c
showTerm (Sum a b) = "(" ++ showTerm a ++ "+" ++ showTerm b ++ ")"
showTerm (Prod a b) = "(" ++ showTerm a ++ showTerm b ++ ")"
---

Where should I put type constraint (Show b) to be able to define Term b as
an instance of Show class?

Actually, I would like to say that Term b is an instance of Show iff b is
and not to put constraint on b.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070709/a792d5df/attachment.htm


More information about the Haskell-Cafe mailing list