pa_float.ml

   1: (* The following function takes an expr syntax node and replaces 
   2:    all occurrences of int constants and operators by their float equivalent.
   3: 
   4:    The code is directly derived from the section on the quotations 
   5:    for manipulating OCaml syntax trees in the reference manual.
   6: 
   7:    This code can be easily reused by copy-pasting.
   8: *)
   9: let rec subst_float expr =
  10:   let loc = MLast.loc_of_expr expr in
  11:   let se = subst_float in
  12:   let sel = List.map subst_float in
  13:   let spwel = List.map (fun (p, w, e) -> (p, w, se e)) in
  14:   match expr with
  15:       <:expr< $e1$ . $e2$ >> ->          <:expr< $se e1$ . $se e2$ >>
  16:     | <:expr< $anti:e$ >> ->             <:expr< $anti:se e$ >>
  17:     | <:expr< $e1$ $e2$ >> ->            <:expr< $se e1$ $se e2$ >>
  18:     | <:expr< $e1$ .( $e2$ ) >> ->       <:expr< $se e1$ .( $se e2$ ) >>
  19:     | <:expr< [| $list:el$ |] >> ->      <:expr< [| $list:sel el$ |] >>
  20:     | <:expr< $e1$ := $e2$ >> ->         <:expr< $se e1$ := $se e2$ >>
  21:     | <:expr< $chr:c$ >> ->              expr
  22:     | <:expr< ($e$ :> $t$) >> ->         <:expr< ($se e$ :> $t$) >>
  23:     | <:expr< ($e$ : $t1$ :> $t2$) >> -> <:expr< ($se e$ : $t1$ :> $t2$) >>
  24:     | <:expr< $flo:s$ >> ->              expr
  25:     | <:expr< for $s$ = $e1$ $to:b$ $e2$ do { $list:el$ } >> -> 
  26:           <:expr< for $s$ = $se e1$ $to:b$ $se e2$ do { $list:sel el$ } >>
  27:     | <:expr< fun [ $list:pwel$ ] >> ->  <:expr< fun [ $list:spwel pwel$ ] >>
  28:     | <:expr< if $e1$ then $e2$ else $e3$ >> -> 
  29:         <:expr< if $se e1$ then $se e2$ else $se e3$ >>
  30: 
  31:     | <:expr< $int:s$ >> -> (* we change the int constants into floats *)
  32:         let x = string_of_float (float (int_of_string s)) in
  33:         <:expr< $flo:x$ >>
  34: 
  35:     | <:expr< ~ $i$ : $e$ >> ->          <:expr< ~ $i$ : $se e$ >>
  36:     | <:expr< lazy $e$ >> ->             <:expr< lazy $se e$ >>
  37:     | <:expr< let $opt:b$ $list:pel$ in $e$ >> -> 
  38:         let pel' = List.map (fun (p, e) -> (p, se e)) pel in
  39:         <:expr< let $opt:b$ $list:pel'$ in $se e$ >>
  40: 
  41:     | <:expr< $lid:s$ >> -> (* we override the basic operators + - * / *)
  42:         (match s with
  43:              "+" | "-" | "*" | "/" -> <:expr< $lid: s ^ "."$ >>
  44:            | _ -> expr)
  45: 
  46:     | <:expr< match $e$ with [ $list:pwel$ ] >> ->
  47:         <:expr< match $se e$ with [ $list:spwel pwel$ ] >> 
  48:     | <:expr< { $list:pel$ } >> -> 
  49:         let pel' = List.map (fun (p, e) -> (p, se e)) pel in
  50:         <:expr< { $list:pel'$ } >>
  51:     | <:expr< do { $list:el$ } >> ->     <:expr< do { $list:sel el$ } >>
  52:     | <:expr< $e1$ .[ $e2$ ] >> ->       <:expr< $se e1$ .[ $se e2$ ] >>
  53:     | <:expr< $str:s$ >> -> expr
  54:     | <:expr< try $e$ with [ $list:pwel$ ] >> -> 
  55:         <:expr< try $e$ with [ $list:spwel pwel$ ] >>
  56:     | <:expr< ( $list:el$ ) >> ->        <:expr< ( $list:sel el$ ) >>
  57:     | <:expr< ( $e$ : $t$ ) >> ->        <:expr< ( $se e$ : $t$ ) >>
  58:     | <:expr< $uid:s$ >> ->              expr
  59:     | <:expr< while $e$ do { $list:el$ } >> -> 
  60:         <:expr< while $se e$ do { $list:sel el$ } >>
  61: 
  62:     | _ -> 
  63:         Stdpp.raise_with_loc loc 
  64:           (Failure 
  65:              "syntax not supported due to the \
  66:               lack of Camlp5 documentation")
  67: 
  68: EXTEND
  69:   Pcaml.expr: LEVEL "expr1" [
  70:     [ "FLOAT"; e = Pcaml.expr -> subst_float e ]
  71:   ];
  72: END;;

This document was generated using caml2html