At 11:18 25-9-00 -0300, Prof. José Romildo Malaquias wrote:

[...skip...]
>And then how would I define data types based on Fn ? The math expressions
>my system has to deal is expressed as something like
>
>         data Expr = Int
>                   | App Fn [Expr]
>
>I cannot just define
>
>         data (FnExt fn) => Expr fn = Int
>                                    | App fn [Expr fn]
>
>because the second value constructor would not be general enough
>and the values of the second form would be all sums, or all products,
>and so on.

[...skip...]

>Anny comments?


The trick is to construct all of your recursive data structures also in an 
overloaded fassion. I have worked out your example (and checked it with GHC 
4.08.1). See below.

The first part is what I said in my last e-mail. The second part handles 
extensible expressions. You go through the same routine: (1) define an 
extensible type constructor class for Expr (ExprExt), (2) split your Expr 
data alternatives into separate type constructors (INT, CTE, VAR, and APP), 
and (3) define these types as instances of ExprExt.

The interesting case is obviously (APP fn expr). As you can see below, you 
express to what type constructor classes the parameters should belong.

In addition, we have found it to be convenient in the Object I/O Library to 
have a number of additional type constructors that are declared to be 
instances, namely to construct lists (List) and pairs (Pair). See also below.

Regards,

Peter

==========================================================
-- (1) for Fn
class FnExt a where
      -- Define your class member functions here
-- (2)
data Sum = Sum
data Pro  = Pro
data Pow  = Pow
-- (3)
instance FnExt Sum where fn x = x
instance FnExt Pro where fn x = x
instance FnExt Pow where fn x = x

-- (1) for Expr
class ExprExt a where
      -- Define your class member functions here
-- (2)
data INT         = INT Integer
data CTE         = CTE String
data VAR         = VAR String
data APP fn expr = APP fn expr
-- (3)
instance ExprExt INT where ...
instance ExprExt CTE where ...
instance ExprExt VAR where ...
instance (FnExt fn,ExprExt expr) => ExprExt (APP fn expr) where ...

-- Convenient types when constructing lists and pairs:

data List expr      -- Lists for convenience when you do have expressions 
of same type
     = List [expr]
infixr 9 :^:        -- This is basically a tuple, but you can leave out 
brackets
data Pair expr1 expr2
     = expr1 :^: expr2

instance (ExprExt e) => ExprExt (List e) where ...
instance (ExprExt e1,ExprExt e2) => ExprExt (Pair e1 e2) where ...


Reply via email to