Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
(* To compile: ocamlc -I +camlp4 -c -pp 'camlp4o pa_extend.cmo q_MLast.cmo' pa_oo.ml To use: ocaml camlp4o.cma pa_oo.cmo or ocamlc -pp 'camlp4o -I . pa_oo.cmo' *) let expand_access _loc mut id e kind = let id' = id^"'" in let decl = <:class_str_item< value $opt: mut <> None$ $lid:id$ = $e$ >> and reader = <:class_str_item< method $id$ = $lid:id$ >> and writer = <:class_str_item< method $"set_"^id$ $lid:id'$ = $lid:id$ := $lid:id'$ >> in let l = decl :: match kind with None -> [] | Some k -> match k with `R -> [reader] | `W -> [writer] | `RW -> [reader;writer] in <:class_str_item< declare $list:l$ end >> let expand_set _loc e1 e2 = match Pa_o.bigarray_set _loc e1 e2 with Some e -> e | None -> match e1 with <:expr< $o$ # $x$ >> -> <:expr< $o$ # $"set_"^x$ $e2$ >> | _ -> <:expr< $e1$ := $e2$ >> DELETE_RULE Pcaml.expr: SELF; "<-"; Pcaml.expr LEVEL "expr1" END;; EXTEND GLOBAL: Pcaml.class_str_item Pcaml.expr; Pcaml.class_str_item: [ [ "val"; "mutable"; lab = LIDENT; e = cvalue_binding; kind = cvalue_kind -> expand_access _loc (Some "") lab e kind | "val"; lab = LIDENT; e = cvalue_binding; kind = cvalue_kind -> expand_access _loc None lab e kind ] ]; cvalue_kind: [ [ kind = OPT [ "with"; k = [ "reader" -> `R | "writer" -> `W | "accessor" -> `RW ] -> k] -> kind ] ]; cvalue_binding: [ [ "="; e = Pcaml.expr -> e | ":"; t = Pcaml.ctyp; "="; e = Pcaml.expr -> <:expr< ($e$ : $t$) >> ] ]; Pcaml.expr: LEVEL ":=" [ [ e1 = SELF; "<-"; e2 = Pcaml.expr LEVEL "expr1" -> expand_set _loc e1 e2 ] ]; Pcaml.expr: LEVEL "simple" [ [ "{|"; cf = LIST1 obj_record SEP ";"; "|}" -> (* self = OPT [ "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> | "("; p = patt; ")" -> <:patt< $p$ >> ]; *) MLast.ExObj (_loc, None, cf) ] ]; obj_record: [ [ "inherit"; ce = Pcaml.class_expr -> <:class_str_item< inherit $ce$ >> | mf = OPT "mutable"; lab = LIDENT; ty = OPT [ ":"; t = Pcaml.ctyp -> t]; "="; e = Pcaml.expr LEVEL "expr1" -> expand_access _loc mf lab e (Some(if mf = None then `R else `RW)) ] ]; END;;