Commits

camlspotter  committed 7889481

added meth annotation

  • Participants
  • Parent commits bb4a0d2

Comments (0)

Files changed (6)

 version = "0.10.0"
 description = "ocaml_conv - type_conv, meta_conv based OCaml value printer"
 requires = "meta_conv"
-archive(byte) = "ocaml_conv.cmo"
-archive(native) = "ocaml_conv.cmx"
-exists_if = "ocaml_conv.cma"
+archive(byte) = "ocaml_conv.cma"
+archive(native) = "ocaml_conv.cmxa"
 
 

File ocaml/META.in

+version = "@version@"
+description = "ocaml_conv - type_conv, meta_conv based OCaml value printer"
+requires = "meta_conv"
+archive(byte) = "ocaml_conv.cma"
+archive(native) = "ocaml_conv.cmxa"
+
+

File ocaml/OMakefile

 OCAMLINCLUDES += ../lib
 
+PACKAGES[] =
+    compiler-libs.common
+
 LIBFILES[] =
-   ocaml
-   ocaml_conv
+    ocaml
+    ocaml_conv
 
-LIB = ocaml_conv
+LIB[] = 
+    ocaml_conv
 
 MyOCamlLibrary($(LIB), $(LIBFILES))
 

File ocaml/ocaml.ml

 	(fun ppf -> fprintf ppf sep)
 	(format_list sep f) xs
 
-let rec format ppf = function
-  | Bool b -> fprintf ppf "%b" b
-  | Int31 i -> fprintf ppf "%d" i
-  | Int63 i -> fprintf ppf "%Ld" i
-  | Int32 i -> fprintf ppf "%ldl" i
-  | Int64 i -> fprintf ppf "%LdL" i
-  | Nativeint32 i -> fprintf ppf "%ldn" i
-  | Nativeint64 i -> fprintf ppf "%Ldn" i
-  | Float f -> fprintf ppf "%F" f
-  | Char c -> fprintf ppf "%C" c
-  | String s -> fprintf ppf "%S" s
-  | List ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
-  | Array ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
-  | Variant (tag, []) -> fprintf ppf "%s" tag
-  | Variant (tag, ts) -> fprintf ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
-  | Poly_variant (tag, []) -> fprintf ppf "`%s" tag
-  | Poly_variant (tag, ts) -> fprintf ppf "@[<2>`%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
-  | Record fields -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
-  | Object fields -> fprintf ppf "@[<2>object @[%a@] end@]" (format_list "@ " (fun ppf (f, v) -> fprintf ppf "method %s= %a" f format v)) fields
-  | Tuple ts -> fprintf ppf "(@[<2>%a@])" (format_list ",@ " format) ts
-  | Unit -> fprintf ppf "()"
+let format ?(no_poly=false) ppf v = 
+  let rec format ppf = function
+    | Bool b -> fprintf ppf "%b" b
+    | Int31 i -> fprintf ppf "%d" i
+    | Int63 i -> fprintf ppf "%Ld" i
+    | Int32 i -> fprintf ppf "%ldl" i
+    | Int64 i -> fprintf ppf "%LdL" i
+    | Nativeint32 i -> fprintf ppf "%ldn" i
+    | Nativeint64 i -> fprintf ppf "%Ldn" i
+    | Float f -> fprintf ppf "%F" f
+    | Char c -> fprintf ppf "%C" c
+    | String s -> fprintf ppf "%S" s
+    | List [] -> fprintf ppf "[]"
+    | List ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
+    | Array ts -> fprintf ppf "[ @[%a@] ]" (format_list ";@ " format) ts
+    | Variant (tag, []) -> fprintf ppf "%s" tag
+    | Variant (tag, [t]) -> fprintf ppf "@[<2>%s@ @[%a@]@]" tag format t
+    | Variant (tag, ts) -> fprintf ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Poly_variant (tag, [])  when no_poly -> fprintf ppf "%s" tag
+    | Poly_variant (tag, [t]) when no_poly -> fprintf ppf "@[<2>%s@ @[%a@]@]" tag format t
+    | Poly_variant (tag, ts)  when no_poly -> fprintf ppf "@[<2>%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Poly_variant (tag, []) -> fprintf ppf "`%s" tag
+    | Poly_variant (tag, [t]) -> fprintf ppf "@[<2>`%s@ @[%a@]@]" tag format t
+    | Poly_variant (tag, ts) -> fprintf ppf "@[<2>`%s@ (@[%a@])@]" tag (format_list ",@ " format) ts
+    | Record fields -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
+    | Object fields when no_poly -> fprintf ppf "@[<2>{ @[%a@] }@]" (format_list ";@ " (fun ppf (f, v) -> fprintf ppf "%s= %a" f format v)) fields
+    | Object fields -> fprintf ppf "@[@[<2>object@,@[%a@]@]@,end@]" (format_list "@ " (fun ppf (f, v) -> fprintf ppf "method %s= %a" f format v)) fields
+    | Tuple ts -> fprintf ppf "(@[%a@])" (format_list ",@ " format) ts
+    | Unit -> fprintf ppf "()"
+  in
+  format ppf v
 
-let format_with f ppf v = format ppf (f v)
+let format_with ?(no_poly=false) f ppf v = format ~no_poly ppf (f v)

File ocaml/ocaml.mli

 
 type ocaml = t
 
-val format : Format.formatter -> t -> unit
-val format_with : ('a -> t) -> Format.formatter -> 'a -> unit
+val format : ?no_poly: bool -> Format.formatter -> t -> unit
+val format_with : ?no_poly: bool -> ('a -> t) -> Format.formatter -> 'a -> unit
+(** [no_poly=true] prints polymorphic variants and objects as non-poly variants and records *)
+

File pa/pa_meta_conv.ml

 
 EXTEND Gram
   GLOBAL: constructor_declaration constructor_declarations row_field label_declaration
-          type_declaration
+          type_declaration meth_decl
   ;
   
   constructor_declaration: 
           Ast.TyDcl(_loc, n, tpl, tk, cl)
     ] ];
 
+  meth_decl:
+      [ [ lab = a_LIDENT; "(:"; e = expr; ":)"; ":"; t = poly_type -> 
+          Hashtbl.add annotations (_loc, lab) e;
+          TyCol (_loc, 
+                 TyId(_loc, <:ident< $lid:lab$ >> ), 
+                 t )
+        | lab = a_LIDENT; "as"; n = a_STRING; ":"; t = poly_type -> 
+          Hashtbl.add annotations (_loc, lab) <:expr< $str:n$ >>;
+          TyCol (_loc, 
+                 TyId(_loc, <:ident< $lid:lab$ >> ), 
+                 t )
+      ] ]
+    ;
+
   (*  `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag *)
 
 (*  comma_idents: