pa_records.ml

   1: let make_record_expr loc l =
   2:   let fields =
   3:     List.map (fun ((loc, name, mut, t), default) -> 
   4:                 (<:patt< $lid:name$ >>, <:expr< $lid:name$ >>)) l in
   5:   <:expr< { $list:fields$ } >>
   6: 
   7: let expand_record loc type_name l =
   8:   let type_def = 
   9:     let fields = List.map fst l in
  10:     <:str_item< type $lid:type_name$ = { $list:fields$ } >> in
  11:   let expr_def =
  12:     let record_expr = make_record_expr loc l in
  13:     let f =
  14:       List.fold_right
  15:         (fun ((loc, name, mut, t), default) e ->
  16:            match default with
  17:                None ->
  18:                  <:expr< fun ~ $Ploc.VaVal name$ -> $e$ >>
  19:              | Some x ->
  20:                  <:expr< fun ? ($lid:name$ = $x$) -> $e$ >>)
  21:         l
  22:         <:expr< fun () -> $record_expr$ >> in
  23:     <:str_item< value rec $lid: "create_" ^ type_name$ = $f$ >> in
  24:   <:str_item< declare $type_def$; $expr_def$; end >>
  25: 
  26: EXTEND
  27:   GLOBAL: Pcaml.str_item;
  28: 
  29:   Pcaml.str_item: LEVEL "top" [
  30:     [ "record"; type_name = LIDENT; "="; 
  31:       "{"; l = LIST1 field_decl SEP ";"; "}" -> expand_record loc type_name l ]
  32:   ];
  33: 
  34:   field_decl: [
  35:     [ mut = OPT "mutable";
  36:       name = LIDENT; ":"; t = Pcaml.ctyp; 
  37:       default = OPT [ "="; e = Pcaml.expr LEVEL "simple" -> e ] -> 
  38:         ((loc, name, (mut <> None), t), default) ]
  39:   ];
  40: END;;

This document was generated using caml2html