Pa float

From Gallium

Jump to: navigation, search

Contents


The goal

We want to create a syntax extension alike the FLOAT one of Martin Jambon. More precisely, we want

let x = Float.( 3/2 - sqrt (1/3) )
let f x =
  Float.( 
    let pi = acos(-1) in
    x/(2*pi) - x**(2/3)
  )

to be translated into

let x = (3. /. 2.) -. (sqrt (1. /. 3.))
let f x =
  let pi = acos(-1.) in
  x /. (2. *. pi) -. x**(2. /. 3.)

Expression transformation

Let us rephrase our goal. Given an expression of the form Float.( <expr> ), we want to return <expr> suitably transformed so that the operators +, -,... are the usual corresponding operators on float and integer constants are interpreted as their float counterpart. That transformation will by done by a "map" function of type Ast.expr -> Ast.expr. Defining such a function was burdensome with camlp4 3.09 because one also had to explicitely map the part of the expression one did not want to change (see Martin Jambon's example). The new Camlp4 offers an easy way to define such functions by inheriting from the class Ast.map and overriding some methods, in our case expr. Thanks to quotations to match the abstract syntax tree, the transformation code looks very natural:

class float_subst _loc = object
    inherit Ast.map as super
    method _Loc_t _ = _loc
    method expr =
      function
      | <:expr< ( + ) >> -> <:expr< ( +. ) >>
      | <:expr< ( - ) >> -> <:expr< ( -. ) >>
      | <:expr< ( * ) >> -> <:expr< ( *. ) >>
      | <:expr< ( / ) >> -> <:expr< ( /. ) >>
      | <:expr< $int:i$ >> ->
        let f = float(int_of_string i) in <:expr< $`flo:f$ >>
      | e -> super#expr e
  end

Note the active antiquotation $`flo:f$ that expects a float instead of a string representing a float.

We can easily test our expression mapper in the toplevel:

        Objective Caml version 3.11+dev2 (2007-05-08)

# #load "camlp4of.cma";;
	Camlp4 Parsing version 3.11+dev2 (2007-05-08)
# open Camlp4.PreCast;;
# let _loc = Loc.ghost;;
val _loc : Camlp4.PreCast.Loc.t = <abstr>
# (* declare the float_subst object *)
# let ast = (new float_subst _loc)#expr <:expr< 3/2 - sqrt (1/3) >>;;
val ast : Camlp4.PreCast.Ast.expr = (* the AST is displayed *)
# Printers.OCaml.print_implem <:str_item< let _ = $ast$ >>;;
let _ = (3. /. 2.) -. (sqrt (1. /. 3.));;
- : unit = ()

Local binding

Now we want to trigger this expression transformation inside the Float.( ... ) parenthesis. We will register this new construction using the functor based approach. First we define a module identifying our syntax extension:

module Id = struct
  let name = "pa_float"
  let version = "1.0"
end

Then the extension is declared inside the functor Make and activated as a side effect of the functor application:

module Make (Syntax : Sig.Camlp4Syntax) = struct
  open Sig
  include Syntax

  (* code of the syntax extension *)
end

let module M = Register.OCamlSyntaxExtension Id Make in ()

The code of the syntax extension first declares the float_subst class above and then uses it to EXTEND Caml syntax with:

EXTEND Gram
    GLOBAL: expr;

    expr: LEVEL "simple"
    [ [ "Float"; "."; "("; e = SELF; ")" -> (new float_subst _loc)#expr e ]
    ]
    ;
  END

Compiling the extension

Suppose the code is in the file pa_float.ml. Compile it to an object file with:

ocamlc -o pa_float.cmo -I +camlp4 camlp4lib.cma -pp camlp4of.opt  -c pa_float.ml


Full code

module Id = struct
  let name = "pa_float"
  let version = "1.0"
end

open Camlp4

module Make (Syntax : Sig.Camlp4Syntax) = struct
  open Sig
  include Syntax

  class float_subst _loc = object
    inherit Ast.map as super
    method _Loc_t _ = _loc
    method expr =
      function
      | <:expr< ( + ) >> -> <:expr< ( +. ) >>
      | <:expr< ( - ) >> -> <:expr< ( -. ) >>
      | <:expr< ( * ) >> -> <:expr< ( *. ) >>
      | <:expr< ( / ) >> -> <:expr< ( /. ) >>
      | <:expr< $int:i$ >> ->
        let f = float(int_of_string i) in <:expr< $`flo:f$ >>
      | e -> super#expr e
  end;;

  EXTEND Gram
    GLOBAL: expr;

    expr: LEVEL "simple"
    [ [ "Float"; "."; "("; e = SELF; ")" -> (new float_subst _loc)#expr e ]
    ]
    ;
  END
end

let module M = Register.OCamlSyntaxExtension Id Make in ()


The following changes are needed to get the above code to compile (OCaml ≥ 3.10.1 and 3.11+dev12):

module Id = struct
  let name = "pa_float"
  let version = "1.0"
end

open Camlp4

module Make (Syntax : Sig.Camlp4Syntax) = struct
  open Sig
  include Syntax

  class ['a] float_subst _loc = object
    inherit Ast.map as super
    method _Loc_t (_ : 'a) = _loc
    method expr =
      function
      | <:expr< ( + ) >> -> <:expr< ( +. ) >>
      | <:expr< ( - ) >> -> <:expr< ( -. ) >>
      | <:expr< ( * ) >> -> <:expr< ( *. ) >>
      | <:expr< ( / ) >> -> <:expr< ( /. ) >>
      | <:expr< $int:i$ >> ->
        let f = float(int_of_string i) in <:expr< $`flo:f$ >>
      | e -> super#expr e
  end;;

  EXTEND Gram
    GLOBAL: expr;

    expr: LEVEL "simple"
    [ [ "Float"; "."; "("; e = SELF; ")" -> (new float_subst _loc)#expr e ]
    ]
    ;
  END
end

let module M = Register.OCamlSyntaxExtension(Id)(Make) in ()


Extending pa_float for other modules

This is a change to pa_float to allow using other modules, with a special case still in place for Float. For example:

Matrix.(m1 + m2)

translates to:

Matrix.add m1 m2

It also allows nesting expansions:

Matrix.(m1 + m2 *: Float.(1 + 2))

translates to:

Matrix.add m1 (Matrix.mul_scalar m2 (1. +. 2.))
module Id = struct
  let name = "pa_float"
  let version = "1.0"
end

open Camlp4

module Make (Syntax : Sig.Camlp4Syntax) = struct
  open Sig
  include Syntax

  (* There is a special case for floating point numbers because:
     a) I use them
     b) It is probably more efficient than making a Float module *)
  let is_float =
    function
      "Float" -> true
    | _ -> false

  class ['a] float_subst _loc = object
    inherit Ast.map as super
    method _Loc_t (_ : 'a) = _loc
    method expr =
      function
      | <:expr< ( + ) >> -> <:expr< ( +. ) >>
      | <:expr< ( - ) >> -> <:expr< ( -. ) >>
      | <:expr< ( * ) >> -> <:expr< ( *. ) >>
      | <:expr< ( / ) >> -> <:expr< ( /. ) >>
      | <:expr< $int:i$ >> ->
        let f = float(int_of_string i) in <:expr< $`flo:f$ >>
      | e -> super#expr e
  end;;

  (* The general case for any other module *)
  class ['a] module_subst _loc m = object
    inherit Ast.map as super
    method _Loc_t (_ : 'a) = _loc
    method expr =
      function
      | <:expr< ( + ) >> -> <:expr< $uid:m$.add >>
      | <:expr< ( - ) >> -> <:expr< $uid:m$.sub >>
      | <:expr< ( * ) >> -> <:expr< $uid:m$.mul >>
      | <:expr< ( / ) >> -> <:expr< $uid:m$.div >>
      | <:expr< ( +: ) >> -> <:expr< $uid:m$.add_scalar >>
      | <:expr< ( -: ) >> -> <:expr< $uid:m$.sub_scalar >>
      | <:expr< ( *: ) >> -> <:expr< $uid:m$.mul_scalar >>
      | <:expr< ( /: ) >> -> <:expr< $uid:m$.div_scalar >>
      | e -> super#expr e
  end;;

  EXTEND Gram
    GLOBAL: expr;

    expr: LEVEL "simple"
    [
      [ m = UIDENT; "."; "("; e = SELF; ")" ->
        if is_float m then
          (* Special case for Float *)
          (new float_subst _loc)#expr e
        else
          (* General case for any other module *)
          (new module_subst _loc m)#expr e ]
    ]
    ;
  END
end

let module M = Register.OCamlSyntaxExtension(Id) in
let module M' = M(Make) in
()
Personal tools
Espace privé