Caml masquotte Mocac : a module generator for relational types

Version 0.3.0

Where is it ?

mocac's source files are here.

How to install it?

See the INSTALL file in the source directory.
For Windows: see the INSTALL.win file in the source directory.

What is it ?

Mocac is a generator of construction functions for Caml concrete data types with algebraic invariants and maximal sharing facilities. Algebraic invariants are specified by using keywords denoting equational theories like commutativity and associativity. The construction functions generated by Mocac allow each equivalence class to be represented by a unique value.

How does it work ?

Mocac parses a special .mlm file and produces a regular Caml module (i.e. a pair of an interface file and an implementation file).
The .mlm file is similar to a Caml .mli file: it must declare a (private) type with the possible addition of special annotations to specify the relations that the constructors verify.
Mocac then generates the construction functions for the constructors, such that all the specified relations indeed hold for the values of the type defined.

Type definitions for mocac have the same syntax as those for Objective Caml with the addition of algebraic relations associated to the constructors defined in the type.

As an additional benefit, you can obtain maximal sharing between the values built by the construction functions, if you use the special --sharing option of the mocac compiler.

How can one use it ?

Simply call mocac with your .mlm file as argument.
For Windows: call sh mocac with your .mlm file as argument.

Grammar

Moca extends the Caml grammar as follows:

constr-decl ::= constr-name [annotation]
  constr-name of typexpr [annotation]
annotation ::= begin {relation}+ end
side ::= left
  right
invopp ::= inverse
  opposite
relation ::= commutative
  associative
  involutive
  idempotent [side]
  neutral [side] ( constr-name )
  nilpotent ( constr-name )
  invopp [side] ( constr-name [, constr-name] )
  inverse neutral ( constr-name [, constr-name] )
  distributive [side] ( constr-name )
  unary distributive ( constr-name [, constr-name] )
  distributive invopp [side] ( constr-name )
  absorbent [side] ( constr-name )
  absorbing [side] ( constr-name )
  rule pattern -> pattern

Semantics

We give the equational theory corresponding to every keyword and the properties of representatives generated by Mocac.
If C is commutative,
then C(x,y)=C(y,x) and, for every value matching C(x,y), we have Pervasives.compare x y < 0.
If C is associative,
then C(C(x,y),z)=C(x,C(y,z)) and no value matches C(C(x,y),z).
If C is involutive,
then C(C(x))=x and no value matches C(C(x)).
idempotent
is the conjunction of idempotent left and idempotent right.
If C is idempotent left,
then C(x,C(x,y))=C(x,y) and no value matches C(x,C(x,y)).
If C is idempotent right,
then C(C(x,y),y)=C(x,y) and no value matches C(C(x,y),y).
neutral (D),
is the conjunction of neutral left (D) and neutral right (D).
If C is neutral left (D),
then C(D,x)=x and no value matches C(D,x).
If C is neutral right (D),
then C(x,D)=x and no value matches C(x,D).
If C is nilpotent (A),
then C(C(x))=A and no value matches C(C(x)).
inverse (I,E)
is the conjunction of inverse left (I,E) and inverse right (I,E).
If C is inverse left (I,E),
then C(I(x),x)=E and no value matches C(I(x),x).
If C is inverse right (I,E),
then C(x,I(x))=E and no value matches C(x,I(x)).
If C is neutral [side] (E),
then inverse [side'] (I) is equivalent to inverse [side'] (I,E).
If C is inverse [side] (I,E) and absorbent [side'] (A),
then the construction function associated to C raises the exception (Failure "Division by Absorbent") when one of its arguments is A.
If I is inverse neutral (E),
then I(E)=E and no value matches I(E).
If I is inverse neutral (E,A),
then I(E)=A and no value matches I(E).
distributive (D)
is the conjunction of distributive left (D) and distributive right (D).
If C is distributive left (D),
then C(D(x,y),z)=D(C(x,z),C(y,z)) and no value matches C(D(x,y),z).
If C is distributive right (D),
then C(z,D(x,y))=D(C(z,x),C(z,y)) and no value matches C(z,D(x,y)).
If I is unary distributive (C,D),
then I(C(x,y))=D(I(y),I(x)) and no value matches I(C(x,y)).
unary distributive (C)
is equivalent to unary distributive (C,C).
distributive inverse (I)
is the conjunction of distributive inverse left (I) and distributive inverse right (I).
If C is distributive inverse left (I),
then C(I(x),y)=I(C(x,y)) and no value matches C(I(x),y).
If C is distributive inverse right (I),
then C(x,I(y))=I(C(x,y)) and no value matches C(x,I(y)).
absorbent (A)
is the conjunction of absorbent left (A) and absorbent right (A).
If C is absorbent left (A),
then C(A,x)=A and no value matches C(A,x).
If C is absorbent right (A),
then C(x,A)=A and no value matches C(x,A).
absorbing (D)
is the conjunction of absorbing left (D) and absorbing right (D).
If C is absorbing left (D),
then C(D(x,y),y)=y and no value matches C(D(x,y),y).
If C is absorbing right (D),
then C(x,D(x,y))=x and no value matches C(x,D(x,y)).
If C has rule l -> r,
then C(l)=r and no value matches C(l).
This annotation is provided for expert user, and should only be used when the previous predefined annotations are not sufficient. In the generated code, the constructors in r are replaced by calls to the corresponding construction functions; the simplifications induced by user's rules are applied first and as much as possible. When there is a user's defined rule annotation in the type specification, the generated code by Moca is not guaranteed to be correct or even to terminate anymore.

Examples

Here is the suitable definition for the data type representing the values of an additive group with one binary operation Add, a neutral element Zero, an opposite unary operator Opp, and a generator One:

type t = private
   | Zero
   | One
   | Opp of t
   | Add of t * t
     begin
       associative
       commutative
       neutral (Zero)
       opposite (Opp)
     end
;;

The algebraic properties of all the operators of the group operators are simply specified for the Add operation. The keywords associative, commutative, neutral, and opposite are Moca specific and set the expected properties of the constructor Add.

If we suppose this code to be in the file group.mlm, then the call mocac group.mlm generates the module Group as the two files group.mli and group.ml.

The interface file group.mli declares the t private type that is the support for the values of the group, and declares the signature of the construction functions for the constructors. It contains the following declarations:

type t = private
   | Zero
   | One
   | Opp of t
   | Add of t * t
;;
val add : t * t -> t;;
val one : t;;
val opp : t -> t;;
val zero : t;;

Now the file group.ml defines the type t and the corresponding construction functions. It is equivalent to:

type t =
   | Zero
   | One
   | Opp of t
   | Add of t * t
;;

let rec add z =
  match z with
  | (Zero, y) -> y
  | (x, Zero) -> x
  | (Add (x, y), z) -> add (x, add (y, z))
  | (Opp x, y) -> insert_inv_add x y
  | (x, Opp y) -> insert_inv_add y x
  | (x, y) -> insert_inv_add (opp x) y

and delete_add x u =
  match u with
  | Add (y, _) when x < y -> raise Not_found
  | Add (y, t) when x = y -> t
  | Add (y, t) -> Add (y, delete_add x t)
  | _ when u = x -> Zero
  | _ -> raise Not_found

and insert_inv_add x u =
  try delete_add x u with
  | Not_found -> insert_add (opp x) u

and insert_add x u =
  match u with
  | Add (y, _) when x < y -> Add (x, u)
  | Add (y, t) -> Add (y, insert_add x t)
  | _ when x > u -> Add (u, x)
  | _ -> Add (x, u)

and one = One

and opp x =
  match x with
  | Zero -> Zero
  | Opp x -> x
  | Add (x, y) -> add (opp x, opp y)
  | _ -> Opp x

and zero = Zero;;

All the values of the type t are now normalized with respect to the group's rules (put it another way: there is no value of type t that is not normalized). For instance:

# add (one, add (zero, opp one));;
- : t = Zero

The directory examples in the distribution contains many other examples of data structures with their corresponding modules generated by mocac.

Bibliography

On the implementation of construction functions for non-free concrete data types, F. Blanqui, T. Hardin and P. Weis, ESOP'07.

Contact

Frédéric Blanqui or Pierre Weis

This file was created on the 11th of April 2005.


Last modification date: Friday, April 27, 2007.
Copyright © 2005 - 2007 INRIA, all rights reserved.