You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
90 lines
2.4 KiB
90 lines
2.4 KiB
7 years ago
|
(*
|
||
|
|
* Copyright (c) 2009 - 2013 Monoidics ltd.
|
||
|
|
* Copyright (c) 2013 - present Facebook, Inc.
|
||
|
|
* All rights reserved.
|
||
|
|
*
|
||
|
|
* This source code is licensed under the BSD style license found in the
|
||
|
|
* LICENSE file in the root directory of this source tree. An additional grant
|
||
|
|
* of patent rights can be found in the PATENTS file in the same directory.
|
||
|
|
*)
|
||
|
|
|
||
|
|
(** The Smallfoot Intermediate Language: Annotations *)
|
||
|
|
open! IStd
|
||
|
|
module L = Logging
|
||
|
|
module F = Format
|
||
|
|
|
||
|
|
type parameters = string list [@@deriving compare]
|
||
|
|
|
||
|
|
(** Type to represent one @Annotation. *)
|
||
|
|
type t =
|
||
|
|
{ class_name: string (** name of the annotation *)
|
||
|
|
; parameters: parameters (** currently only one string parameter *) }
|
||
|
|
[@@deriving compare]
|
||
|
|
|
||
|
|
let volatile = {class_name= "volatile"; parameters= []}
|
||
|
|
|
||
|
|
(** Pretty print an annotation. *)
|
||
|
|
let prefix = match Config.curr_language_is Config.Java with true -> "@" | false -> "_"
|
||
|
|
|
||
|
|
let pp fmt annotation = F.fprintf fmt "%s%s" prefix annotation.class_name
|
||
|
|
|
||
|
|
module Map = PrettyPrintable.MakePPMap (struct
|
||
|
|
type nonrec t = t
|
||
|
|
|
||
|
|
let compare = compare
|
||
|
|
|
||
|
|
let pp = pp
|
||
|
|
end)
|
||
|
|
|
||
|
|
module Item = struct
|
||
|
|
(* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 *)
|
||
|
|
(* type nonrec t = list (t, bool) [@@deriving compare]; *)
|
||
|
|
(** Annotation for one item: a list of annotations with visibility. *)
|
||
|
|
type _t = (t * bool) list [@@deriving compare]
|
||
|
|
|
||
|
|
type t = _t [@@deriving compare]
|
||
|
|
|
||
|
|
let equal = [%compare.equal : t]
|
||
|
|
|
||
|
|
(** Pretty print an item annotation. *)
|
||
|
|
let pp fmt ann =
|
||
|
|
let pp fmt (a, _) = pp fmt a in
|
||
|
|
F.fprintf fmt "<%a>" (Pp.seq pp) ann
|
||
|
|
|
||
|
|
let to_string ann =
|
||
|
|
let pp fmt = pp fmt ann in
|
||
|
|
F.asprintf "%t" pp
|
||
|
|
|
||
|
|
(** Empty item annotation. *)
|
||
|
|
let empty = []
|
||
|
|
|
||
|
|
(** Check if the item annodation is empty. *)
|
||
|
|
let is_empty ia = List.is_empty ia
|
||
|
|
end
|
||
|
|
|
||
|
|
module Class = struct
|
||
|
|
let objc_str = "ObjC-Class"
|
||
|
|
|
||
|
|
let cpp_str = "Cpp-Class"
|
||
|
|
|
||
|
|
let of_string class_string = [({class_name= class_string; parameters= []}, true)]
|
||
|
|
|
||
|
|
let objc = of_string objc_str
|
||
|
|
|
||
|
|
let cpp = of_string cpp_str
|
||
|
|
end
|
||
|
|
|
||
|
|
module Method = struct
|
||
|
|
(** Annotation for a method: return value and list of parameters. *)
|
||
|
|
type t = Item.t * Item.t list [@@deriving compare]
|
||
|
|
|
||
|
|
(** Pretty print a method annotation. *)
|
||
|
|
let pp s fmt (ia, ial) = F.fprintf fmt "%a %s(%a)" Item.pp ia s (Pp.seq Item.pp) ial
|
||
|
|
|
||
|
|
(** Empty method annotation. *)
|
||
|
|
let empty = ([], [])
|
||
|
|
|
||
|
|
(** Check if the method annodation is empty. *)
|
||
|
|
let is_empty (ia, ial) = List.for_all ~f:Item.is_empty (ia :: ial)
|
||
|
|
end
|