mocac
's source files are here.
See the INSTALL file in the source directory.
For Windows: see the INSTALL.win file in the source directory.
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.
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.
Simply call mocac
with your .mlm
file as argument.
For Windows: call sh mocac
with your .mlm
file as argument.
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 |
Mocac
.
C
is commutative,C(x,y)=C(y,x)
and, for every value matching
C(x,y)
, we have Pervasives.compare x y < 0
.
C
is associative,C(C(x,y),z)=C(x,C(y,z))
and no value matches
C(C(x,y),z)
.
C
is involutive,C(C(x))=x
and no value matches C(C(x))
.
C
is idempotent left,C(x,C(x,y))=C(x,y)
and no value matches
C(x,C(x,y))
.
C
is idempotent right,C(C(x,y),y)=C(x,y)
and no value
matches C(C(x,y),y)
.
(D)
,(D)
and neutral right
(D)
.
C
is neutral left
(D)
,C(D,x)=x
and no value matches C(D,x)
.
C
is neutral right
(D)
,C(x,D)=x
and no value matches C(x,D)
.
C
is nilpotent
(A)
,C(C(x))=A
and no value matches C(C(x))
.
(I,E)
(I,E)
and inverse right
(I,E)
.
C
is inverse left
(I,E)
,C(I(x),x)=E
and no value matches C(I(x),x)
.
C
is inverse right
(I,E)
,C(x,I(x))=E
and no value matches C(x,I(x))
.
C
is neutral [side] (E)
,(I)
is
equivalent to inverse [side'] (I,E)
.
C
is inverse [side] (I,E)
and
absorbent [side'] (A)
,C
raises the
exception (Failure "Division by Absorbent"
) when one of its
arguments is A
.
I
is inverse
neutral (E)
,I(E)=E
and no value matches I(E)
.
I
is inverse
neutral (E,A)
,I(E)=A
and no value matches I(E)
.
(D)
(D)
and distributive
right (D)
.
C
is distributive
left (D)
,C(D(x,y),z)=D(C(x,z),C(y,z))
and no value matches
C(D(x,y),z)
.
C
is distributive
right (D)
,C(z,D(x,y))=D(C(z,x),C(z,y))
and no value matches
C(z,D(x,y))
.
I
is unary
distributive (C,D)
,I(C(x,y))=D(I(y),I(x))
and no value matches
I(C(x,y))
.
(C)
(C,C)
.
(I)
(I)
and distributive inverse right (I)
.
C
is distributive inverse
left (I)
,C(I(x),y)=I(C(x,y))
and no value matches
C(I(x),y)
.
C
is distributive inverse
right (I)
,C(x,I(y))=I(C(x,y))
and no value matches
C(x,I(y))
.
(A)
(A)
and absorbent right
(A)
.
C
is absorbent
left (A)
,C(A,x)=A
and no value matches C(A,x)
.
C
is absorbent
right (A)
,C(x,A)=A
and no value matches C(x,A)
.
(D)
(D)
and absorbing right
(D)
.
C
is absorbing
left (D)
,C(D(x,y),y)=y
and no value matches C(D(x,y),y)
.
C
is absorbing
right (D)
,C(x,D(x,y))=x
and no value matches C(x,D(x,y))
.
C
has rule
l -> r
,C(l)=r
and no value matches C(l)
.
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.
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
.
This file was created on the 11th of April 2005.