index (GT.index)

Basic Usage

This is a simple demo being run in OCaml toplevel.

# #use "topfind";;
- : unit = ()
Findlib has been successfully loaded. Additional directives:
  #require "package";;      to load a package
  #list;;                   to list the available packages
  #camlp4o;;                to load camlp4 (standard syntax)
  #camlp4r;;                to load camlp4 (revised syntax)
  #predicates "p,q,...";;   to set these predicates
  Topfind.reset();;         to force that packages will be reloaded
  #thread;;                 to enable threads

- : unit = ()
# #require "GT";;
# #require "GT.syntax.all";;
# #require "GT.ppx_all";;

The `deriving` specification will generate

a class for our type
one class per transformation to represent transformation
bunch of functions per transformation to provide `ppx_deriving` like functional interface

# type 'a list = Nil | Cons of 'a * 'a list [@@deriving gt ~options:{fmt; show}];;
type 'a list = Nil | Cons of 'a * 'a list
class virtual ['ia, 'a, 'sa, 'inh, 'extra, 'syn] list_t :
  object
    method virtual c_Cons : 'inh -> 'extra -> 'a -> 'a list -> 'syn
    method virtual c_Nil : 'inh -> 'extra -> 'syn
  end
val gcata_list :
  ('a, 'typ0__003_, 'b, 'c, 'typ0__003_ list, 'd) #list_t ->
  'c -> 'typ0__003_ list -> 'd = <fun>
class ['a, 'b] show_list_t :
  (unit -> 'a -> string) ->
  (unit -> 'a list -> string) ->
  object
    constraint 'b = 'a list
    method c_Cons : unit -> 'a list -> 'a -> 'a list -> string
    method c_Nil : unit -> 'a list -> string
  end
class ['a, 'b] fmt_list_t :
  (Format.formatter -> 'a -> unit) ->
  (Format.formatter -> 'a list -> unit) ->
  object
    constraint 'b = 'a list
    method c_Cons : Format.formatter -> 'a list -> 'a -> 'a list -> unit
    method c_Nil : Format.formatter -> 'a list -> unit
  end
val fmt_list :
  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit =
  <fun>
val list :
  (('a, 'b, 'c, 'd, 'b list, 'e) #list_t -> 'd -> 'b list -> 'e,
   < fmt : (Format.formatter -> 'f -> unit) ->
           Format.formatter -> 'f list -> unit;
     show : ('g -> string) -> 'g list -> string >,
   (('h -> 'i list -> 'j) -> ('k, 'i, 'l, 'h, 'i list, 'j) #list_t) ->
   'h -> 'i list -> 'j)
  GT.t = {GT.gcata = <fun>; plugins = <obj>; fix = <fun>}
val show_list : ('a -> string) -> 'a list -> string = <fun>

# Format.printf "%a\n%!" (fmt_list Format.pp_print_int) (Cons(1, Nil));;
Cons (1, Nil)
- : unit = ()

Example: Processing Expressions

Let us have the following type for simple arithmetic expressions:

type expr =
  | Add of expr * expr
  | Mul of expr * expr
  | Int of int
  | Var of string

One of the first typical "boilerplate" tasks is printing; much like other available generic frameworks this simple goal can be achieved with our library by a little decoration of the original declaration:

# type expr =
  | Add of expr * expr
  | Mul of expr * expr
  | Int of GT.int
  | Var of GT.string [@@deriving gt ~options:{show}];;
type expr =
    Add of expr * expr
  | Mul of expr * expr
  | Int of int
  | Var of string
class virtual ['inh, 'extra, 'syn] expr_t :
  object
    method virtual c_Add : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Int : 'inh -> 'extra -> int -> 'syn
    method virtual c_Mul : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Var : 'inh -> 'extra -> string -> 'syn
  end
val gcata_expr : ('a, expr, 'b) #expr_t -> 'a -> expr -> 'b = <fun>
class ['a] show_expr_t :
  (unit -> expr -> string) ->
  object
    constraint 'a = expr
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end
val expr :
  (('a, expr, 'b) #expr_t -> 'a -> expr -> 'b, < show : expr -> string >,
   (('c -> expr -> 'd) -> ('c, expr, 'd) #expr_t) -> 'c -> expr -> 'd)
  GT.t = {GT.gcata = <fun>; plugins = <obj>; fix = <fun>}
val show_expr : expr -> string = <fun>

For mutually recursive type declarations add decoration only to the last type

type t = Anything
and heap = t [@@deriving gt ~options:{ show }]

In our framework (at least by now) all transformations are expressed by the following common pattern:

fun tr_obj init value -> GT.transform(t) tr_obj init value

or more precisely

GT.fix (fun fself init value ->
    GT.transform tree (new tr_class f_1 ... f_n fself) init value
  ) init value

where

t is a polymorphic type with _n_ parameters;
tr_obj - transformation object for some transformation;
f_1, ..., f_n - transformation functions for type parameters;
init - some initial value (additional parameter);
value - the value to transform of type (a_1, a_2, ..., a_n) t .

Transformations function f_j usually have type inh_j -> a_j -> syn_j . Types inh_j and syn_j may be arbitrary; they can be interpreted as _inherited_ and _synthesized_ attributes for type parameter transformations, if we interpret catamorphisms in attribute-grammar fashion. For example, for "show" `inh_j` = `unit` and `s_j` = `string`.

Transformation object is an object which performs the actual transformation on a per-constructor basis; we can think of it as a collection of methods, one per data type constructor. Transformation objects can be given either implicitly by object expressions or created as instances of transformation classes. Each class, in turn, can be generated by a system, hand-written from scratch or inherited from an existing ones.

In our example the phrase "`with show`" makes the framework to invoke a used-defined plugin, called "`show`". The architecture of the framework is developed to encourage the end-users to provide their own plugins; writing plugins is considered as an easy task.

The key feature of the approach we advocate here is that object-oriented representation of transformations makes them quite easy to modify. For example, if we are not satisfied by the "default" behavior of "show", we can adjust it only for the "cases of interest":

# class show' fself = object
   inherit [_] show_expr_t fself
   method c_Var _ _ s = s
  end;;
class show' :
  (unit -> expr -> string) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end

# GT.transform expr (new show') ()
    (Mul (Var "a", Add (Int 1, Var "b")))
- : string = "Mul (a, Add (Int (1), b))"

Now the result is

"Mul (a, Add (Int (1), b))"

We fixed only the "case of interest"; method "`c_Var`" takes three arguments - the inherited attribute (which is always unit here), the original value (actually, _augmented_ original value, see below), and immediate arguments of corresponding constructor (actually, their _augmented_ versions). In this case "`s`" is just a string argument of the constructor "`Var`".

If we still not satisfied with the result, we can further proceed with fixing things up:

# class show'' fself = object
    inherit show' fself
    method c_Int _ _ i = string_of_int i
  end;;
class show'' :
  (unit -> expr -> string) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end

# GT.transform(expr) (new show'') () (Mul (Var "a", Add (Int 1, Var "b")))
- : string = "Mul (a, Add (1, b))"

In the next step we're going to switch to infix representation of operators; this case is interesting since we have to adjust the behavior of the transformation not only for the single node, but to all its sub-trees as well. Fortunately, this is easy:

# class show''' fself = object
    inherit show'' fself
    method c_Add () _ x y = fself () x ^ " + " ^ fself () y
    method c_Mul () _ x y = fself () x ^ " * " ^ fself () y
  end
class show''' :
  (unit -> expr -> string) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end

# GT.transform(expr) (new show''') () (Mul (Var "a", Add (Int 1, Var "b")))
- : string = "a * 1 + b"

Method "`c_Add`" takes four arguments:

inherited attribute (here unit);
original node;
parameters of the constructor (x and y).

Finally, we may want to provide a complete infix representation (including a minimal amount of necessary brackets):

# class show4 fself =
    let enclose op p x y =
      let prio = function
      | Add (_, _) -> 1
      | Mul (_, _) -> 2
      | _ -> 3
      in
      let bracket f x = if f then "(" ^ x ^ ")" else x in
      bracket (p >  prio x) (fself () x) ^ op ^
      bracket (p >= prio y) (fself () y)
    in
    object
      inherit show''' fself
      method c_Mul _ _ x y = enclose "*" 2 x y
      method c_Add _ _ x y = enclose "+" 1 x y
    end;;
class show4 :
  (unit -> expr -> string) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end

On the final note for this example we point out that all these flavors of "show" transformation coexist simultaneously; any of them can be used as a starting point for further adjustments.

Our next example is variable-collecting function. For this purpose we add "`foldl`" the the list of user-defined plugins:

# type expr =
  | Add of expr * expr
  | Mul of expr * expr
  | Int of GT.int
  | Var of GT.string [@@deriving gt ~plugins:{show; foldl}]
type expr =
    Add of expr * expr
  | Mul of expr * expr
  | Int of int
  | Var of string
class virtual ['inh, 'extra, 'syn] expr_t :
  object
    method virtual c_Add : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Int : 'inh -> 'extra -> int -> 'syn
    method virtual c_Mul : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Var : 'inh -> 'extra -> string -> 'syn
  end
val gcata_expr : ('a, expr, 'b) #expr_t -> 'a -> expr -> 'b = <fun>
class ['syn, 'a] foldl_expr_t :
  ('syn -> expr -> 'syn) ->
  object
    constraint 'a = expr
    method c_Add : 'syn -> expr -> expr -> expr -> 'syn
    method c_Int : 'syn -> expr -> int -> 'syn
    method c_Mul : 'syn -> expr -> expr -> expr -> 'syn
    method c_Var : 'syn -> expr -> string -> 'syn
  end
val foldl_expr : 'a -> expr -> 'a = <fun>
class ['a] show_expr_t :
  (unit -> expr -> string) ->
  object
    constraint 'a = expr
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end
val expr :
  (('a, expr, 'b) #expr_t -> 'a -> expr -> 'b,
   < foldl : 'c -> expr -> 'c; show : expr -> string >,
   (('d -> expr -> 'e) -> ('d, expr, 'e) #expr_t) -> 'd -> expr -> 'e)
  GT.t = {GT.gcata = <fun>; plugins = <obj>; fix = <fun>}
val show_expr : expr -> string = <fun>

With this plugin enabled we can easily express what we want:

# module S = Set.Make (String)

# class vars fself = object
    inherit [S.t,_] foldl_expr_t fself
    method c_Var s _ x = S.add x s
  end
class vars :
  (S.t -> expr -> S.t) ->
  object
    method c_Add : S.t -> expr -> expr -> expr -> S.t
    method c_Int : S.t -> expr -> int -> S.t
    method c_Mul : S.t -> expr -> expr -> expr -> S.t
    method c_Var : S.t -> expr -> string -> S.t
  end

# let vars e = S.elements (GT.transform(expr) (new vars) S.empty e)
val vars : expr -> string list/2 = <fun>

In the default version, foldl_expr_t is generated in such a way that inherited attribute value (in out case of type S.t) is simply threaded through all nodes of the data structure. This behavior as such gives us nothing; however we can redefine the "interesting case" (variable occurrence) to take this occurrence into account.

The next example - expression evaluator - demonstrates the case when we implement transformation class "from scratch". The appropriate class type is rather cumbersome; fortunately, the framework provides us some empty virtual class to inherit from:

# class eval fself = object
    inherit [string -> int, int, _] expr_t
    method c_Var s _ x = s x
    method c_Int _ _ i = i
    method c_Add s _ x y = fself s x + fself s y
    method c_Mul s _ x y = fself s x * fself s y
  end;;
class eval :
  ((string -> int) -> expr -> int) ->
  object
    method c_Add : (string -> int) -> int -> expr -> expr -> int
    method c_Int : (string -> int) -> int -> int -> int
    method c_Mul : (string -> int) -> int -> expr -> expr -> int
    method c_Var : (string -> int) -> int -> string -> int
  end

Since we develop a new transformation, we have to take care of types for inherited and synthesized attributes (when we're extending the existing classes these types are already taken care of). Since our evaluator needs a state to bind variables, the type of inherited attribute is "`string -> int`" and the type of synthesized attribute is just "`int`". The implementations of methods are straightforward.

As a final example we consider expression simplification. This time we can make use of plugin "`map`", which in default implementation just copies the data structure (beware: multiplying shared substructures):

# type expr =
  | Add of expr * expr
  | Mul of expr * expr
  | Int of GT.int
  | Var of GT.string [@@deriving gt ~plugins:{show; foldl; gmap}];;
type expr =
    Add of expr * expr
  | Mul of expr * expr
  | Int of int
  | Var of string
class virtual ['inh, 'extra, 'syn] expr_t :
  object
    method virtual c_Add : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Int : 'inh -> 'extra -> int -> 'syn
    method virtual c_Mul : 'inh -> 'extra -> expr -> expr -> 'syn
    method virtual c_Var : 'inh -> 'extra -> string -> 'syn
  end
val gcata_expr : ('a, expr, 'b) #expr_t -> 'a -> expr -> 'b = <fun>
class ['a, 'b] gmap_expr_t :
  (unit -> expr -> expr) ->
  object
    constraint 'a = expr
    constraint 'b = expr
    method c_Add : unit -> expr -> expr -> expr -> expr
    method c_Int : unit -> expr -> int -> expr
    method c_Mul : unit -> expr -> expr -> expr -> expr
    method c_Var : unit -> expr -> string -> expr
  end
class ['syn, 'a] foldl_expr_t :
  ('syn -> expr -> 'syn) ->
  object
    constraint 'a = expr
    method c_Add : 'syn -> expr -> expr -> expr -> 'syn
    method c_Int : 'syn -> expr -> int -> 'syn
    method c_Mul : 'syn -> expr -> expr -> expr -> 'syn
    method c_Var : 'syn -> expr -> string -> 'syn
  end
val foldl_expr : 'a -> expr -> 'a = <fun>
class ['a] show_expr_t :
  (unit -> expr -> string) ->
  object
    constraint 'a = expr
    method c_Add : unit -> expr -> expr -> expr -> string
    method c_Int : unit -> expr -> int -> string
    method c_Mul : unit -> expr -> expr -> expr -> string
    method c_Var : unit -> expr -> string -> string
  end
val expr :
  (('a, expr, 'b) #expr_t -> 'a -> expr -> 'b,
   < foldl : 'c -> expr -> 'c; gmap : expr -> expr; show : expr -> string >,
   (('d -> expr -> 'e) -> ('d, expr, 'e) #expr_t) -> 'd -> expr -> 'e)
  GT.t = {GT.gcata = <fun>; plugins = <obj>; fix = <fun>}
val gmap_expr : expr -> expr = <fun>
val show_expr : expr -> string = <fun>

In the first iteration we simplify additions by performing constant calculations; we also "normalize" additions in such a way, that if it has one constant operand, then this operand occupies "left" position. The normalization makes it possible to take into account the associativity of addition:

# class simplify_add =
    let (+) a b =
      match a, b with
      | Int a, Int b -> Int (a+b)
      | Int a, Add (Int b, c)
      | Add (Int a, c), Int b -> Add (Int (a+b), c)
      | Add (Int a, c), Add (Int b, d) -> Add (Int (a+b), Add (c, d))
      | _, Int _ -> Add (b, a)
      | _ -> Add (a, b)
    in
    fun fself -> object
      inherit [_,_] gmap_expr_t fself
      method c_Add _ _ x y = fself () x + fself () y
    end
class simplify_add :
  (unit -> expr -> expr) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> expr
    method c_Int : unit -> expr -> int -> expr
    method c_Mul : unit -> expr -> expr -> expr -> expr
    method c_Var : unit -> expr -> string -> expr
  end

As we can see, we again concentrated only on the "interesting case"; the implementation of infix "`+`" may look cumbersome, but this is an essential part of the transformation.

Equally, we can handle the simplification of multiplication:

class simplify_mul =
  let ( * ) a b =
    match a, b with
    | Int a, Int b -> Int (a*b)
    | Int a, Mul (Int b, c)
    | Mul (Int a, c), Int b -> Mul (Int (a*b), c)
    | Mul (Int a, c), Mul (Int b, d) -> Mul (Int (a*b), Add (c, d))
    | _, Int _ -> Mul (b, a)
    | _ -> Mul (a, b)
  in
  fun fself -> object
    inherit simplify_add fself
    method c_Mul _ _ x y = fself () x * fself () y
  end

The class "`simplify_mul`" implements a decent simplifier; however, it overlooks the following equalities: "0*x=0", "0+x=x", and "1*x=x". These cases can be easily integrated into existing implementation:

# class simplify_all fself = object
    inherit simplify_mul fself as super
    method c_Add i it x y =
       match super#c_Add i it x y with
       | Add (Int 0, a) -> a
       | x -> x
    method c_Mul i it x y =
       match super#c_Mul i it x y with
       | Mul (Int 1, a) -> a
       | Mul (Int 0, _) -> Int 0
       | x -> x
  end;;
class simplify_all :
  (unit -> expr -> expr) ->
  object
    method c_Add : unit -> expr -> expr -> expr -> expr
    method c_Int : unit -> expr -> int -> expr
    method c_Mul : unit -> expr -> expr -> expr -> expr
    method c_Var : unit -> expr -> string -> expr
  end

The interesting part of this implementation is an explicit utilization of a superclass' methods. It may looks at first glance that we handle only top-level case; however, due to late binding, for example, fself () x in simplify_mul implementation is bound to the overriden transformation, which is (in this particular case) is simplify_all .

The complete example can be found in file sample/expr.ml .

Package info

authors	https://github.com/Kakadu https://github.com/dboulytchev
changes-files	CHANGES
depends	bisect_ppx camlp5 conf-m4 dune logger-p5 mdx ocaml ocamlfind ocamlgraph odig odoc pa_ppx ppx_inline_test_nobase ppxlib
homepage	https://github.com/PLTools/GT
issues	https://github.com/PLTools/GT/issues
license	LGPL-2.1-or-later
maintainers	Kakadu@pm.me
readme-files	README.md
repo	git+https://github.com/PLTools/GT.git
version	0.5.3