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