Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

[Caml-list] Functorizing large collections of modules

2 views
Skip to first unread message

Yaron M. Minsky

unread,
Mar 17, 2002, 11:14:45 PM3/17/02
to caml...@inria.fr
I'm doing some work where I need a bunch of modules that use the same
module ZZp for doing arithmetic module a given prime P. I wrote a
functor MakeZZp that takes a prime p and returns a module for doing
modular arithmetic over that prime.

Here's the problem. I have a bunch of modules that depend on ZZp, and I
would like them all to be able to reference the same instance of ZZp.
One way of doing would be simply to functorize each and every one of
them separately by ZZp. Then, every time one of these modules
references another, the argument of ZZp would have to be passed on.
Thus, rather than referencing Foo, you'd reference Foo.M(ZZp).

This seems messy and kind of silly. Conceptually what I want is a
single structure like this:

module Library(ZZp:ZZpSig) =
struct

module Foo =
struct ... end

module Bar =
struct ... end

...

end

That way, all the interior modules (Foo, Bar) get to reference the same
ZZp, without having to functorize the individual modules. So, what I'd
like is to be able to do this without sticking the modules Foo and Bar
into the same single large unmanageable file.

So, is there any way of doing this? Or am I just going about it wrong.
Another solution, of course, would be to use no functors at all, and
have a single module ZZp where the parameter (the prime) is mutable. But
that seems both messy and less flexible.

y

--
|--------/ Yaron M. Minsky \--------|
|--------\ http://www.cs.cornell.edu/home/yminsky/ /--------|

Open PGP --- KeyID B1FFD916 (new key as of Dec 4th)
Fingerprint: 5BF6 83E1 0CE3 1043 95D8 F8D5 9F12 B3A9 B1FF D916

-------------------
To unsubscribe, mail caml-lis...@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners

Remi VANICAT

unread,
Mar 18, 2002, 4:06:11 AM3/18/02
to caml...@inria.fr
"Yaron M. Minsky" <ymi...@cs.cornell.edu> writes:

> This seems messy and kind of silly. Conceptually what I want is a
> single structure like this:
>
> module Library(ZZp:ZZpSig) =
> struct
>
> module Foo =
> struct ... end
>
> module Bar =
> struct ... end
>
> ...
>
> end
>
> That way, all the interior modules (Foo, Bar) get to reference the same
> ZZp, without having to functorize the individual modules. So, what I'd
> like is to be able to do this without sticking the modules Foo and Bar
> into the same single large unmanageable file.

you can call the functor in a bigger functor :

file foo.ml

module Make(ZZp:ZZpSig) =
struct ... end

file bar.ml

module Make(ZZp:ZZpSig) =
struct ... end

file library.ml

module Make(ZZp:ZZpSig)=
struct
module Foo = Foo.Make(ZZp)
module Bar = Bar.Make(ZZp)
end
--
Rémi Vanicat
van...@labri.u-bordeaux.fr
http://dept-info.labri.u-bordeaux.fr/~vanicat
-------------------
To unsubscribe, mail caml-lis...@inria.fr Archives: http://caml.inr=
ia.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr=

Yaron M. Minsky

unread,
Mar 18, 2002, 7:23:23 AM3/18/02
to Remi VANICAT, caml...@inria.fr
The problem, I think, with the solution listed below is that I don't see
how Bar can refer to Foo easily. In particular, it seems like every
time Foo.Make(ZZp) references Bar, it really needs to refrence
Bar.Make(ZZp). And come to think of it, I don't know how to do this at
all, since (I think) every invocation of Bar.Make(ZZp) creates an
independent instance of the module.

In particular, imagine Foo needs to reference Bar. Without functors,
the files might look something like this:

foo.ml:

let _ = Bar.snoo (ZZp.snip ())

bar.ml:

let open = ZZp.bark () + ZZp.flip ()

Now, with functors, how would this work?

foo.ml:

module M(ZZp:ZZpSig) =
struct
module Bar = Bar.M(ZZp)
let _ = Bar.snoo (ZZp.snip ())
end

bar.ml:

module M(ZZp:ZZpSig) =
struct
let open = ZZp.bark () + ZZp.flip ()
end

So now foo can refrence bar. But if there's a different module that
wants to look at bar also, it will end up referencing a different
instance of Bar.M(ZZp), which seems problematic.

So now I'm more confused than ever.

y

--
|--------/ Yaron M. Minsky \--------|
|--------\ http://www.cs.cornell.edu/home/yminsky/ /--------|

Open PGP --- KeyID B1FFD916 (new key as of Dec 4th)
Fingerprint: 5BF6 83E1 0CE3 1043 95D8 F8D5 9F12 B3A9 B1FF D916

-------------------
To unsubscribe, mail caml-lis...@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/

Sami Mäkelä

unread,
Mar 18, 2002, 7:56:29 AM3/18/02
to Yaron M. Minsky, caml...@inria.fr
"Yaron M. Minsky" wrote:
> > > Conceptually what I want is a single structure like this:
> > >
> > > module Library(ZZp:ZZpSig) =
> > > struct
> > >
> > > module Foo =
> > > struct ... end
> > >
> > > module Bar =
> > > struct ... end
> > >
> > > ...
> > >
> > > end

what i have used is:

foo.ml:

module Library (ZZp:ZZpSig) =


struct
module Foo = struct ... end

end

bar.ml:

module Library (ZZp:ZZpSig) =
struct
include Foo.Library (ZZp)


module Bar = struct ... end

end

quux.ml:

module Library (ZZp:ZZpSig) =
struct
include Bar.Library (ZZp)
module Quux = struct ... end
end

etc.

there are still few problems, but perhaps this is good enough


> > >
> > > That way, all the interior modules (Foo, Bar) get to reference the same
> > > ZZp, without having to functorize the individual modules. So, what I'd
> > > like is to be able to do this without sticking the modules Foo and Bar
> > > into the same single large unmanageable file.

Yaron M. Minsky

unread,
Mar 19, 2002, 6:33:10 PM3/19/02
to Sami Mäkelä, caml...@inria.fr
The solution suggested below clearly works, but it's just as clearly a
bit of a hack. My feeling is that this is a bit of a fundamental
weakness of ocaml and the module/functor system. OCaml is generally too
module-centric, in that structuring tools are available only up to the
level of modules, and there is no good structure beyond that.

Another example of this weakness is the lack of support for namespaces.
Again, you can hack namespaces into existence by tossing lots of modules
in the same file, but that's clearly a bad solution.

Do any of the other MLs fare better in this department? And do people
have good solutions for the namespace problem or the large-scale functor
problem I outlined earlier?

y

> > > > That way, all the interior modules (Foo, Bar) get to reference the =
same
> > > > ZZp, without having to functorize the individual modules. So, what=
I'd
> > > > like is to be able to do this without sticking the modules Foo and =


Bar
> > > > into the same single large unmanageable file.
> -------------------

> To unsubscribe, mail caml-lis...@inria.fr Archives: http://caml.inr=
ia.fr
> Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr=

--
|--------/ Yaron M. Minsky \--------|
|--------\ http://www.cs.cornell.edu/home/yminsky/ /--------|

Open PGP --- KeyID B1FFD916 (new key as of Dec 4th)
Fingerprint: 5BF6 83E1 0CE3 1043 95D8 F8D5 9F12 B3A9 B1FF D916

-------------------

Fermin Reig

unread,
Mar 19, 2002, 6:51:02 PM3/19/02
to caml...@inria.fr, ymi...@cs.cornell.edu

> From: "Yaron M. Minsky" <ymi...@cs.cornell.edu>

>
> The solution suggested below clearly works, but it's just as clearly a
> bit of a hack. My feeling is that this is a bit of a fundamental
> weakness of ocaml and the module/functor system. OCaml is generally too
> module-centric, in that structuring tools are available only up to the
> level of modules, and there is no good structure beyond that.
>
> Another example of this weakness is the lack of support for namespaces.=20

> Again, you can hack namespaces into existence by tossing lots of modules
> in the same file, but that's clearly a bad solution.
>
> Do any of the other MLs fare better in this department? And do people
> have good solutions for the namespace problem or the large-scale functor
> problem I outlined earlier?
>
> y

SML/NJ provides a very useful way of grouping signatures, structures,
functors, etc into libraries.

Hierarchical Modularity. Matthias Blume and Andrew W. Appel, ACM
Transactions on Programming Languages and Systems, Volume 21, No. 4
(Jul. 1999).

This paper and others can be found in Matthias's web page.

http://cm.bell-labs.com/cm/cs/who/blume/pub.html

Hope that helps,
Fermin

Francois Pottier

unread,
Mar 20, 2002, 4:14:59 AM3/20/02
to caml...@inria.fr

Hello,

Yaron M. Minsky writes:
> The solution suggested below clearly works, but it's just as clearly a
> bit of a hack.

You want Foo and Bar to exist within separate files, even though they are=
both
parameterized by the same module ZZp. This is, I believe, a frequent prob=
lem
for people trying to program in a modular way. It seems that, if you insi=
st
that Foo and Bar should be separately compilable, then you must describe =
their
interface to the compiler, which means you must turn each of them into a
functor, parameterized over ZZp. This leads you to the solution that was
posted, which, I believe, is manageable to a certain degree. Now, if on t=
he
other hand, you don't really care about separate compilation of Foo and B=
ar,
then you can place them in separate files, and have your Makefile
automatically catenate them for compilation. Given the speed of today's
machines, this solution should be acceptable in many cases. I don't know =
of a
third solution, but of course, I'd love to stand corrected.

> Another example of this weakness is the lack of support for namespaces.

It is true that O'Caml has little support for resolving name conflicts
in a modular way, because the semantics of the module language is too
intimately tied with the underlying file system. I suppose a CM-like tool
would help, but I think this issue is separate from the one above.

--
François Pottier
Francois...@inria.fr
http://pauillac.inria.fr/~fpottier/

Alain Frisch

unread,
Mar 20, 2002, 6:29:37 AM3/20/02
to Francois Pottier, Caml list
On Wed, 20 Mar 2002, Francois Pottier wrote:

> > Another example of this weakness is the lack of support for namespaces.
>
> It is true that O'Caml has little support for resolving name conflicts
> in a modular way, because the semantics of the module language is too
> intimately tied with the underlying file system. I suppose a CM-like tool
> would help, but I think this issue is separate from the one above.


It seems that the new -pack feature of ocamlc/ocamlopt (see CVS) addresses
the issue. What kind of extra support for namespace would be needed ?

Concerning the global parametrization, maybe a variation around -pack
could solve the problem. ocamlc -pack would take a list of modules
A1,...An (.cmo+.cmi) and a list of interfaces S1,...,Sm (.cmi) and produce
a functor parametrized by interfaces S1,...Sm and returning a
bundled version of A1,...,An


-- Alain

-------------------
To unsubscribe, mail caml-lis...@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/

Yaron M. Minsky

unread,
Mar 20, 2002, 8:04:32 AM3/20/02
to Alain Frisch, Francois Pottier, Caml list
On Wed, 2002-03-20 at 06:24, Alain Frisch wrote:
> On Wed, 20 Mar 2002, Francois Pottier wrote:
>
> > > Another example of this weakness is the lack of support for namespaces.
> >
> > It is true that O'Caml has little support for resolving name conflicts
> > in a modular way, because the semantics of the module language is too
> > intimately tied with the underlying file system. I suppose a CM-like tool
> > would help, but I think this issue is separate from the one above.
>
>
> It seems that the new -pack feature of ocamlc/ocamlopt (see CVS) addresses
> the issue. What kind of extra support for namespace would be needed ?
>
> Concerning the global parametrization, maybe a variation around -pack
> could solve the problem. ocamlc -pack would take a list of modules
> A1,...An (.cmo+.cmi) and a list of interfaces S1,...,Sm (.cmi) and produce
> a functor parametrized by interfaces S1,...Sm and returning a
> bundled version of A1,...,An

This seems like a plausible solution, although ideally I think the shape
of this multi-module functor should be described in a file, not just on
the command-line. So you could have a file with a kind of dummy
functor:

library.ml

module M(ZZp:ZZpSig) =
struct

end

and the compiler would add the appropriate modules to the end of the
struct, in whatever order is specified on the command-line.

One wonders, of course, whether this can easily be implemented without
tossing out separate compilation. If not, then maybe some kind of hack
where you do a manual substitution to make this work would be the right
idea, as suggested by Francois.


y

--
|--------/ Yaron M. Minsky \--------|
|--------\ http://www.cs.cornell.edu/home/yminsky/ /--------|

Open PGP --- KeyID B1FFD916 (new key as of Dec 4th)
Fingerprint: 5BF6 83E1 0CE3 1043 95D8 F8D5 9F12 B3A9 B1FF D916

-------------------

0 new messages