Adding Type Classes to Functional-logic Languages - CiteSeerX

0 downloads 0 Views 256KB Size Report
Type classes were proposed in WB89] in order to generalise the classic Hindley/Milner type system to ..... datatype Color. = white | red | green | yellow | black.
Adding Type Classes to Functional-logic Languages Juan Jose Moreno-Navarro Julio Mari~no Andres del Pozo Angel Herranz-Nieva Julio Garca-Martn LSIIS - Facultad de Informatica, UPM

Abstract: The paper discusses the advantages of introducing type classes into functionallogic languages. Type classes are a powerful type system included in the functional language Haskell that allow to model some of the object oriented programming features. A number of problems arise when type classes are combined with the functional and logic characteristics of the language, and we sketch some solutions. On the other hand it has a number of advantages like the declarative model of Prolog attribute variables or the integration in the language of bounded quanti ers.

1 Motivation

During the last decade, several proposals have been made to achieve the combination of the most important declarative programming paradigms (see [Han94b, MN94b] for surveys). The resulting languages have been called functional logic languages. They o er features from functional programming (nested expressions, lazy evaluation higherorder features) and logic programming (logical variables, partial data structures, search for solutions). As a result, functional-logic languages have more expressive power than logic programming and functional programming by themselves: The use of logical variables and built-in search mechanisms, for instance, improves the expressivity of functional languages. On the other hand, we can mention that functional logic languages have a greater degree of abstraction (provided, for instance, from the use of higher order features) and the possibility of the use of lazy evaluation. But the improvement in the expressive power does not come from a mere addition of characteristics of functional or logic programming. Very often the combination of paradigms opens the possibility of new declarative concepts, a better understanding of previous features or a broader use of a construction of the language. Among others, we can mention: Functional logic languages have more ecient evaluation mechanisms than logic programming due to the (deterministic!) reduction of functional expressions. Thus, impure features of Prolog to restrict the search space, like the cut operator, can be avoided in functional logic languages [LW91]. The functional avour of the language allows for richer operational semantics like lazy evaluation, residuation, etc. that should include Prolog SLD and functional rewriting as particular cases. Higher order functions can be added to the model increasing the expressive power by making programs more abstract and by reusing general schemes to handle recursive 





 Address correspondence: Campus de Montegancedo s/n, Boadilla del Monte 28660, Madrid, Spain, e-mail: [email protected], URL: http://lml.ls.fi.upm.es/jjmoreno. This work is partially supported by the spanish project TIC/93-0737-C02-02.

1



data structures. Higher order functions serve to hide part of the control, thus improving expressiveness. Functional logic languages are also a natural framework to include higher order search, like in -Prolog [NM88] The notion of negation as failure can be extended to complete partial de ned functions by using default rules [MN94a].

Curry [HKMN95] is an attempt to integrate most of the proposals in the area in a single and standard language. In this paper we study the advantages of the addition of type classes [WB89] to Curry. Type classes are present in the functional language Haskell [HPJW92] and can handle some of the object oriented features (like the overloading of operations). Apart from this advantage we have found very interesting applications. The paper does not try to give all the details about the integration of type classes and functional logic languages. Instead of this, we are just giving an overview of the problems, solutions and advantages that we will develop in depth in forthcoming papers. This means that we are not providing yet theoretical foundations for our proposal but some practical potential uses. Firstly, the logic component of the language provides a natural solution to the ambiguity of certain programs written with type classes. While Haskell has to include some restrictions to avoid the problem we propose to treat the ambiguity by exploring all the possible meanings of an expression. Type classes provide a declarative and simple reading of metaterms and attribute variables that can be found in modern Prolog systems (like SICSTUS or ECLIPSE). The programmer can use metaterms to implement her own constraint systems. The standard Curry prelude can contain the most interesting ones. They can also be used in Curry to extend higher order uni cation. We provide examples of both features. We can also integrate bounded quanti ers in the language in a straightforward and simple manner. The type class hierarchy allows us to provide di erent quanti er operators depending on the type class they run over. Several examples show the increase of expressivity obtained by using bounded quanti ers.

2 Functional-logic Languages: Curry

The language Curry has been proposed as an attempt to combine the currently separated research e orts of the functional and logic programming communities and to boost declarative programming in general. It includes most of the interesting features of existing functional logic languages (BABEL, Alf, K-Leaf, Slog, Escher, etc). The goal of Curry is to o er more expressive power than functional and logic programming by themselves and to provide a declarative view of some impure features of both styles of programming. For instance, functions provide for more ecient and deterministic evaluation strategies and are a declarative replacement of some Prolog pruning operators. The main features of Curry are the following: Operational semantics: There are several di erent proposal about the best operational semantics of functional logic languages. Residuation allows for the ecient deterministic evaluation of function calls and provides concurrent programming, while narrowing is the basis of a complete evaluation strategy but requires 

the implementation of search features. Curry is based on a combination of narrowing and residuation. If no evaluation strategy is speci ed, lazy narrowing [AEH94, LLFRA93, MNKMC+ 93] is choosen by default. Curry is a higher-order language supporting the common functional programming techniques by partial function application and lambda abstraction. Since Curry is also a logic language, it allows logical variables also for functional values(see [NM88, AK96] among others). Curry provides a declarative model of I/O by considering I/O operations as transformations on the outside world. A monadic I/O model, like in Haskell, is used for this purpose. The language also plan to include constraints, implication and quanti ers, and a module system. At this moment, Curry's syntax is not completely stable. This means that the syntax used along the paper can change in the nal version of the language. Curry allows data type declarations like: 





datatype boolean = true | false

datatype nat = 0 | s nat

datatype tree A = leaf A | node (tree A) A (tree A)

Functions de nitions start with a header with the function name and its type declaration of the form function f :1 -> 2 -> -> n ->  where 1 ; : : : ; n ;  are polymorphic types and  is not a functional type, followed by conditional equations as f t1 : : : tn = C => t where the conditional part \C =>" can be omitted. The left-hand side consists of the function symbol applied to a sequence of n patterns (i.e. variables or (full) applications of constructors to patterns). The condition C is a conjunction of boolean expressions. A boolean expression is built from boolean functions, prede ned boolean operators like \," (and), \;" (or) and not [MNR92]. not changes true to false and vice versa; it is not handled by nite failure. The language also allows for \if-then-else" like expressions in the form C => e1 # e2. Curry provides a prede ned equality equal for all the types, that must be understood as a strict equality in the sense of [MNR92]. A strict equation is provable, if the left and right hand side are reducible to the same ground constructor term. In order to ensure the well-de nedness and determinism of a function speci ed by several equations, additional non-ambiguity requirements are necessary (see [MNR92] for details). In contrast to functional languages, we allow extra variables in the conditions, i.e., variables which do not occur in the left-hand side. These extra variables provide the power of logic programming since a search for appropriate values is necessary in order to apply a conditional rule with extra variables. If the user want to de ne its own evaluation order, every function de nition can be completed with an evaluation restriction of the form \eval f restriction". The annotation imposes the evaluation of the argument until it has the shape demanded by the restriction (i.e. some kind of residuation is used). 

3 Overview of Type Classes

Type classes were proposed in [WB89] in order to generalise the classic Hindley/Milner type system to handle overloading in an object oriented style. Type classes can handle

the overloading of the equality, numeric operations and much more. It is once of the most innovative feature of Haskell, but they can be adapted to any functional language. Basically, a type class de nes a type class constructor that can be applied to a type variable. The type class can contain function headers that can be applied to all the instance types that belong to the class. Once a type class is declared, the programmer can de ne instances of the class, providing concrete code for the class functions. Consider, for instance, the class of numeric types, with operations for adding (+), multiplying (*) and computing the inverse (negate) of numbers. As concrete instances, we can de ne the integers (Int) and the oating point numbers (Float). The following code uses a Haskell like syntax adapted to Curry. class Num A where function (+), (*) : A -> A -> A

function negate

instance Num Int where (+)

=

: A -> A

instance Num Float where

addint

(+)

% Built-in operation to add integers

=

addfloat

% Built-in operation to add floats

(*)

=

mulint

(*)

=

mulfloat

negate

=

negint

negate

=

negfloat

We can also write functions and classes that depend on other classes as shown in the following example. The function square works for every numeric type. The class Fractional can be de ned over a numeric type. The example of Complex numbers shows the di erent uses of an overloaded function (the lhs use of + means the addition of complex numbers, while occurences in the rhs are of oating point addition). function square:

Num A => A -> A

square x = x * x instance Num Complex where C (a, b) + C (c, d) = C (a+c, b+d)

class Num A => Fractional A where (/) :

A -> A -> A ...

A program written using type classes can be translated into an equivalent program that does not use overloading. The translated program can be typed in the Hindley/Milner type system. This gives a possible implementation technique.

4 Functional-logic Languages and Type Classes

If we simply add type classes to Curry we can notice that it is dicult to type some expressions at compile time, like X + Y if X and Y are logical variables. We know that both must belong to a type of the class Num but we do not know to which of them. However a similar problem was present in the original formulation of type classes even if logical variables are not present in the language. Without any additional restriction we can write some programs using type classes that have no unique type. Consider for instance, the following piece of code, where we declare the class of collections that can be created from a list of integers. We can compute the size of a collection. As instances of this class we can de ne trees (where the size is the depth of the tree), sets (where the size is the number of di erent elements) and lists (where the size is the length). Notice that we omit some well known functions. class Collection A where function create : [int] -> A

function size : A -> int

function insert : Ord A => A -> tree A -> tree A insert x empty = node empty x empty insert x (node ls r rs) = x > r => node ls r (insert x rs) # node (insert x ls) r rs instance Collection (tree int) where create []

=

empty

size empty

=

0

create [X|L]

=

insert X (create L)

size (node ls r rs)

=

1 +

(max (size ls) (size rs)) datatype set A = emptyset | union A (set A) function member : Eq A => A -> set A -> boolean member x emptyset = false member x (union y s) = x == y ; (member x s) instance Collection (set int) where create []

=

emptyset

size emptyset

=

0

create [X|L]

=

union X (create L)

size (union x s)

=

(member x s) =>

size s # 1 + (size s) instance Collection (list int) where create L = L

size L = length L

Consider now the goal expression

L == (create [1, 1, 2, 3, 4, 4]) => size L

The type checker cannot provide a type for this expression whitout giving a type to the variable L. Haskell includes the so-called monomorphic restriction to avoid such situations. However, we can look at this problem from a logical point of view. The problem is that variable L has more than one possible type. As L is implicitly existentially quanti ed, our approach is to try with all the possible types for the variable and to give a result for each alternative (upon backtracking), indicating the type of the variable used. The execution of the previous expression will yield to the results: L == 4 6 5

(create [1, 1, 2, 3, 4, 4]) => size L

> L == (create [1, 1, 2, 3, 4, 4]) => size L

>4 We have sketched a program translation method to transform a Curry program with type classes into a simple Curry program, in such a way that the resulting program is well typed and the usual backtracking is used to compute the possible answers. We have not too much space to explain the technique, so we simply show the resulting program in the previous example. datatype ColD A = coldict (([int] -> A) * (A -> int)).

ColDtree : ColD (tree A). ColDtree = coldict (create tree, size tree). ColDset : ColD (set A). ColDset = coldict (create set, size set). ColDlist : ColD (list A).

ColDlist = coldict (create list, size list). datatype AllColTypes A = tr(tree A) | st(set A) | ls(list A) datatype AllColD A = trd(ColD(tree A)) | std(ColD(set A)) | lsd(ColD(list A)) create : AllColD A -> ([int] -> AllColTypes A). create trd(coldict(c,s)) = x.tr(c x) create std(coldict(c,s)) = create lsd(coldict(c,s)) = x.ls(c x)

n n

size : AllColD A -> (AllColTypes A -> int). size trd(coldict(c,s)) = x.tr(s x) size std(coldict(c,s)) = size lsd(coldict(c,s)) = x.ls(s x)

n n

n

n

x.st(c x)

x.st(s x)

(member dic [(trd ColDtree), (std ColDset), (lsd ColDlist)]), L == (create dic [1, 1, 2, 3, 4, 4]= => size dic L.

Eq

 ??HHHH HHH Ord Text Fin  H  ? HH HH  ? Num Enum ? H HH HHH Ix HH Fractional Real HH HH HHH HHH Floating Integral RealFrac HHH 

Binary

RealFloat

Figure 1: Hierarchy of standard classes In the sequel, we assume the class hierarchy of gure 1, adapted from the one used in Haskell. Eq is the class of types that have equality. Ord includes all the ordered types, while Enum is the class of enumerated types. Ix collects the types that are indexed (see Section 7), while Fin is the class of nite types. Numeric classes have been (partially) presented before but we refer to [HPJW92] for the details. The de nition of a part of them is the following: class Eq A where function (==), (/=) : A -> A -> boolean x /= y = not (x == y)

class (Eq A) => Ord A where function () : A -> A -> boolean function max, min : A -> A -> A class (Ord A) => Enum A where function [..] : A -> A -> [A]

-- [n..m]

class (Eq A) => Fin A where function dom : (A -> B) -> [A]

-- list of the elements of the type

5 Equality and Metaterms

Metaterms (or attribute variables) are one of the most useful features of some Prolog versions (like Sicstus Prolog or Eclipse). The programmer can mark some variables as attributed. For variables with the same attribute, the programmer can provide his own code for the uni cation. They have been used for several interesting applications, like the integration of constraint systems or the handling of concurrency. However, they have no clear declarative meaning. Most of the interesting uses of metaterms can be obtained by using the ability of Curry with type classes to rede ne the equality for a given type. For simplicity, we assume that the de nition of the equality for a type is used during the uni cation process, i.e. the uni cation code is replaced by the equality code1 . As an example, we are going to provide an implementation of variables constrained to belong to a nite domain. The polymorphic type FiniteDomain is used to store the information about the constraint of a variable. A predicate declare is used to give an initial value to the variable. The function to element converts an element to a nite domain value. domain is the usual function that returns the current domain of a variable. datatype FiniteDomain A = elem A | enum [A]

function declare : FiniteDomain A -> [A] -> boolean declare (enum L) L = true function to element : A -> FiniteDomain A to element X = (elem X) function domain : FiniteDomain A -> [A] domain (elem V) = [V] domain (enum X) = X

Now we need to rede ne the equality for the type FiniteDomain what will model uni cation of two nite domain variables. Before we sketch the code we need some previous remarks. The code needs some meta-programming predicates (in particular, it is enough to detect when a variable is free or not { boolean function var). It can be argued that these predicates are not declarative but they have been included in Godel [HL94] with a declarative meaning. On the other hand we need some kind of destructive assignment. Again, it does not sound very declarative. However, it can be modelled in several declarative ways (monads { i.e. higher order {, di erence lists { i.e. logical variables {, etc). For the purpose of this paper we assume that we have the class of assignable variables with the following de nition. class Assigment A where function value :

A -> A

function assign :

A -> A -> boolean

Now we can write the code for == in FiniteDomain. The key idea is the following: The uni cation of two sets is solved by computing its intersection. The uni cation of a concrete value with a set checks the membership of the value into the set. We skip the code for the operations. X == Y = (not var X), (not var Y), -- Two sets (equal (value X) (enum ListX)), (equal (value Y) (enum listY)), ListXY == (intersection ListX List Y), not (equal ListXY []), (equal ListXY [V]) -- Singleton intersection => (assign X (elem V)), (assign Y (elem V))

1 This method will be re ned providing some additional syntax.

#

(assign X (enum ListXY)), (assign Y (enum ListXY))

X == Y = (not var X), (not var Y), -- Element + Set (equal (value X) (elem V)), (equal (value Y) (enum listY)), (member V ListXY), (assign Y (elem V)) X == Y = . . .

-- Set + Element / Similar

X == Y = (var X), (not var Y), -- Variable + Set (equal (value Y) (enum listY)), (declare X ListY) X == Y = . . .

-- Set + Variable / Similar

X == Y = (var X), (not var Y), (equal (value Y) (elem V)), (equal X

-- Variable + Element V)

X == Y = . . .

-- Element + Variable / Similar

Now we can declare variables over a nite domain and use them into any function call. The uni cation will re the previous equality code in order to maintain a coherent information. Furthermore, if the nite domain ranges on a numeric type, we can declare FiniteDomain as an instance of the class Num and then rede ne the operations for addition, multiplication, etc. for nite domain values. However, the type system prohibits expressions like f 1, when f : FiniteDomain int -> ... or X == 1 if X has type FiniteDomain int. Instead of this, we need to write these expressions as f (to element 1) or X == (to element 1). We are studying how to complement type classes (that only provides a method to handle overloading) with some kind of subtypes. If we allow to declare int as a subtype of FiniteDomain (subclass in object oriented terminology) then f 1 is correctly typed. The next section will provide an example of the use of nite domain variables. The method can be extended to other constraint systems, like disequalities over the Herbrand Universe, integer values, oat values, etc. It worths to note that we are not proposing to adopt the previous method to include constraint systems into Curry. Probably, we can not provide a very ecient implementation as demanded for practical applications. The combination of arbitrary constraints with sophisticated narrowing strategies is a topic for current and future research. The rede nition of the equality/uni cation can be used as a prototype for testing the combination of a concrete constraint system with, for instance, lazy evaluation. When the experiments are satisfactory the constraint system can be included in the core of the language. The second example relies with higher order uni cation. Curry includes higher order uni cation but the search space is very limited: the algorithm can only nd functions composed from constant functions, projections and functions de ned by the program itself. Of course, higher order uni cation is undecidable in general, but there are some classes of domains where HO uni cation is complete, as boolean functions. For instance, we can write an uni cation algorithm for functions in the domain boolean -> boolean: instance Eq (boolean -> boolean) where

F == G = F true = G true, F false = G false.

Again, we can understood this code as a declarative meaning for uni cation between boolean functions, while the implementation can provide a more ecient code (by using, for instance, boolean uni cation).

6 Bounded Quanti ers

Bounded quanti ers is a declarative way to increase the expressiveness of pure logic programs. The idea is to allow a limited form of quanti cation and the result is that the programmer can write very simple but powerful programs. For instance, the speci cation of the predicate subset (subset Xs Y s) X Xs Y Ys X = Y is executable with bounded quanti ers. Bounded quanti ers were proposed by Kluzniak [Klu91] and discussed by Voronkov [Vor92]. We allow in Curry four P di erent quanti ers:Q universal ( ) and existential ( ) quanti ers and summatories ( ) and productories ( ). Notice that the last two are functional (they return a value). The simplest form is to run the quanti cation over a list. There are no type class restrictions to these operations but they can be de ned in a polymorphic way. The code for these functions can be written by any student.  8

2

9

2

8

9

function forall X in, exists X in: [A] -> (A -> boolean) -> boolean % forall X in l p , exists X in l p eval forall X in, exists X in 1 : ground

 8 x 2 l (p x)

P

 9 x 2 l (p x)

Q

function sum X in, prod X in: Num B => [A] -> (A -> B) -> B % sum X in l f , prod X in l f x 2 l x 2 l eval sum X in, prod X in 1 : ground





(f x)

forall X in [] P = true . . .

(f x)

forall X in [E|R] P = P E ; forall X in R P

However we can provide other bounded quanti ers if we x the type class of the bounds. If the quanti er run into a nite type the quanti cation can cover the whole type. function forall X, exists X: Finite A => (A -> boolean) -> boolean , exists X p % forall X p

 8 x 2 A (p x)

P

Q

 9 x 2 A (p x)

function sum X, prod X: Finite A, Num B: (A -> B) -> B % sum X f , prod X f x 2 A x 2 A forall X P = forall X in (Domain P) P . . .





(f x)

(f x)

Finally, when the type for the bounds is of the Enum class the quanti ers can be applied to all the elements between an initial and a nal value. function forall X between, exists X between: Enum A => A -> A -> (A -> boolean) -> boolean % forall X between iv fv p % exists X between iv fv p eval forall X between, exists X between 1, 2 : ground

 8 x 2 fiv::fvg (p x)  9 x 2 fiv::fvg (p x)

P

Q

function sum X between, prod X between: Enum A,Num B => A -> A -> (A -> B) -> B vf vf % sum X between iv fv f , prod X between iv fv f x=iv x=iv eval sum X between, prod X between 1, 2 : ground



(f x)

forall X between I F P = forall X in [I..F] P . . .



(f x)

Now we can codify the subset predicate in the following way, where the notation exp is the Curry syntax for a lambda expression.

nX.

function subset: [A] -> [A] -> boolean

subset Xs Ys = forall X in Xs (n X. (exits X in Ys n Y. X == Y)) The compiler can provide a more comfortable syntax for these functions allowing for the quanti cation of several variables at the same time, making the -abstraction implicit, and giving a single function name. For instance:

 forall X  forall X in forall [X1 in fv1..f1g, X2 in fv2..f2g,...] (p X1 X2...)  forall X between Let us show another example using the new notation. We want to know if a formula is satis able. We assume a suitable type Formula to represent logical formulas, a function evaluate to get the boolean value of a formula and a function variables to compute the (boolean) variables of a formula. forall [X1, X2, ...]

(p X1 X2 ...)

forall [X1 in L1, X2 in L2, ...]

(p X1 X2 ...)

datatype Formula = variable boolean or Formula * Formula

| |

and Formula * Formula | ...

function satisfiable: Formula -> boolean satisfiable F = (forall [X in (variables F)] exists [Z] X = Z), evaluate F => true

Notice that the variable Z has type boolean that is a nite type.

7 Examples

We nish the paper discussing three examples where most of the previous features are shown. The examples involve the use of indexable arrays. Arrays have several declarative interpretations that hide the destructive assignment. In particular Haskell considers arrays as functions whose domains are isomorphic to contiguous subsets of the integers. Such these functions can be implemented in an ecient way. We propose to borrow this feature from Haskell and to adapt it to Curry: Arrays are subscripted by any type of the indexed class Ix. The type of an array has the form Ix A => Array A B, where A is the type of the indexes and B represents the type of the components. An array is created with the function array. The subscript function is, for simplicity, denoted with the usual notation [ ]. The bounds of an array can be known by applying the functions lower bound, upper bound, bound, index that return, respectively, the lower index, the upper index, the pair of both and the list of indexes. 

function function function function function function

array [] bounds index lower bound upper bound

: : : : : :

Ix Ix Ix Ix Ix Ix

A A A A A A

=> => => => => =>

A * A Array Array Array Array Array

-> Array A B A B -> A -> B A B -> A * A A B -> [A] A B -> A * A A B -> A * A

Now we can proceed with the examples. They are adapted from [Apt95] where they are presented in a Prolog style. The rst example is the well known 8-queens problem. It uses an array to represent the board and a generate and test style of programming.

Example 7.1 Place 8 queens on the chess board so that they do not check each other.

function queens : Array int int -> boolean queens X = (safe X), (generate X) -> true function safe : Array int int -> boolean safe X = forall [I in (index X), J in [I+1..upper bound X]] (X[I] /= X[J], X[I] /= X[J] + (J-I), X[I] /= X[J] + (I-J) => true function generate : Array int int -> boolean generate X = forall [I in (index X)] exists [J] in (domain X[I]) X [I] = J

The goal expression creates the array, declares the domain of its elements and call the function queens:

Board == (array (1,8)), forall [I in (index Board)] (declare Board[I] [1..8]), (queens Board)

Example 7.2 Colour a map in such a way that there are no two neighbours with the same colour.

The solution is got by generating an array of colours for each country and then just write the condition of the speci cation. This means that the proposed program is absolutely declarative. datatype Color

= white | red | green | yellow | black

datatype Countries = spain | italy | portugal | france | ... function map colour : Array Countries Color -> boolean map colour X = (constrain X), (generate X) => true function neighbours : countries -> [countries] neighbours spain = [portugal, france] neighbours portugal = [spain] . . . function constrain : Array Countries Color -> boolean constrain X = forall [I, J in (neighbours I)] X [I] /= X[J] => true

The goal expression is:

Map == (array Countries), forall [C in (dom Countries)] (declare Map[C] (dom Color)), (map colour Map)

8 Conclusion

The paper presents some of the advantages of adding type classes to a functional logic language like Curry. Among its interesting uses we can mention the use of a more powerful type system, a purer model for metaterms and the inclusion of bounded quanti ers in the language. However, we need to handle some expressions that can not be typed at compile time. We propose the use of the backtracking mechanism in such these cases. It is honest to say that up to now the paper is just a collection of ideas around the use of type classes in functional logic languages. The goal of the paper is to establish that it is a promising area of work, but some of the solutions proposed need a deeper work. The theoretical foundations of the use of type classes in Curry remain to be done and it is an exciting area of work. The use of type constraints can help to this task. Another interesting future work is the combination of type classes and subtypes in order to complete the object oriented facilities. The model of some constraint systems

will be simpli ed. As the constraint store is some kind of state, the use of monads to model it is another interesting approach to investigate. Bounded quanti ers are easily included in the language. However, it is interesting to study the relationship between some of the programming techniques using bounded quanti ers with those involving list comprehensions. It is obvious that there are a lot of common ideas underlying both techniques.

References [AEH94]

S. Antoy, R. Echahed, and M. Hanus. A needed narrowing strategy. In Proc. 21st POPL, pages 268{279, Portland, 1994. [AK96] J. Anastasiadis and H. Kuchen. Higher order babel: Language and implementation. In Proc. Workshop on ELP, 1996. [Apt95] K. Apt. Arrays, bounded quanti cation and iteration in logic and constraint logic programming. In GULP-PRODE'95, pp. 19{35. Univ. di Salerno, 1995. [Han94b] M. Hanus. The integration of functions into logic programming: From theory to practice. Journal of Logic Programming, 19&20:583{628, 1994. [HKMN95] M. Hanus, H. Kuchen, and J.J. Moreno-Navarro. Curry: A truly functional-logic language. In ILPS'95 Post Conference Workshop on Declarative Languages for the Future, 1995. [HL94] P.M. Hill, J.W. Lloyd. The Godel Programming Language. MIT Press, 1994. [HPJW92] P. Hudak, S. Peyton Jones, and P. Wadler. Report on the programming language Haskell (version 1.2). SIGPLAN Notices, 27(5), 1992. [Klu91] F. Kluzniak. Towards practical executable speci cations in logic. Research report lith-ida-r-91-26, Dep. of Computer Science - Linkopink Univ., 1991. [LLFRA93] R. Loogen, F. Lopez Fraguas, and M. Rodrguez Artalejo. A demand driven computation strategy for lazy narrowing. PLILP'93, pages 184{200. Springer LNCS 714, 1993. [LW91] R. Loogen, S. Winkler. Dynamic detection of determinism in functional logic languages. PLILP'91, pages 335{346. Springer LNCS 528, 1991. [MN94a] J.J. Moreno-Navarro. Default rules: An extension of constructive negation for narrowing-based languages. ICLP'94, pp. 535{552. The MIT Press, 1994. [MN94b] J.J. Moreno-Navarro. Expressivity of functional-logic languages and their implementation. In GULP-PRODE'94. Univ. Politecnica de Valencia, 1994. + [MNKMC 93] J.J. Moreno-Navarro, H. Kuchen, J. Marino-Carballo, S. Winkler, and W. Hans. Ecient lazy narrowing using demandedness analysis. In Proc. of the 5th PLILP, pages 167{183. Springer LNCS 714, 1993. [MNR92] J.J. Moreno-Navarro and M. Rodrguez-Artalejo. Logic programming with functions and predicates: The language BABEL. Journal of Logic Programming, 12:191{223, 1992. [NM88] G. Nadathur and D. Miller. An overview of Prolog. In Proc. 5th Conference on Logic Programming & 5th Symposium on Logic Programming (Seattle), pages 810{827. MIT Press, 1988. [Vor92] A. Voronkov. Logic programming with bounded quanti ers. In LPAR, pages 486{514. Springer LNCS 592, 1992. [WB89] P. Wadler and S. Blott. How to make ad-hoc polymorphism less ad- hoc. In ACM Symposium on POPL, pages 60{76. ACM Press, 1989.