Pa float
From Gallium
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
()