Skip to content
Browse files

[enhance] opadoc, surfaceAst, qmlAst: transfer opacapi and module inf…

…o from SurfaceAst to QmlAst and print it in api file
  • Loading branch information...
1 parent 2009fdd commit 4495235c3834300c67234c70836665fa69b893d6 @Aqua-Ye Aqua-Ye committed Sep 19, 2012
View
7 compiler/libqmlcompil/qmlAst.ml
@@ -1092,6 +1092,11 @@ type doctype_access_directive =
| `package (* visible only in the current package *)
]
+type doctype_info = [
+| `opacapi
+| `module_
+]
+
(**
add information around an apply or a lifted lambda
*)
@@ -1156,7 +1161,7 @@ type qml_directive = [
| `apply_ty_arg of ty list * ty_row list * ty_col list
| `abstract_ty_arg of TypeVar.t list * RowVar.t list * ColVar.t list
- | `doctype of (string list * doctype_access_directive)
+ | `doctype of (string list * doctype_access_directive * doctype_info list)
| `hybrid_value
(** Directive for qmljs. First expression is a client
function whose type must be (string -> 'a).
View
1 compiler/libqmlcompil/qmlDirectives.ml
@@ -520,4 +520,3 @@ let to_string d =
| `visibility_annotation (`public `funaction) -> "publish_funaction"
| `public_env -> "public_env"
-
View
2 compiler/libqmlcompil/qmlPrint.ml
@@ -360,7 +360,7 @@ object (self)
| Q.Bypass (_, s) -> Format.pp_print_string f ("%%" ^ (BslKey.to_string s) ^ "%%")
| Q.Coerce (_, e,ty) -> pp f "%a : %a" self#under_coerce#expr e self#ty ty
| Q.Path (_, el, knd, select) -> self#path f (el, knd, select)
- | Q.Directive (_, `module_, [e], _) -> pp f "{%a}" self#reset#expr e
+ | Q.Directive (_, `module_, [e], _) -> pp f "module{%a}" self#reset#expr e
| Q.Directive (_, dir, exprs, tys) -> self#directive f dir exprs tys
method bind_field fmt (f, d) = pp fmt "%s = %a" f self#under_record#expr d
method binding f (i, e) =
View
37 compiler/opa/pass_OpaDocApi.ml
@@ -179,11 +179,11 @@ let process_opa ~(options : E.opa_options) env =
with their label (so that we can find their types and position)
*)
let remove_code_doctype annotmap (qmlAst : QmlAst.code) :
- (QmlAst.annotmap * (string list * QmlAst.expr * QmlAst.doctype_access_directive) list) * QmlAst.code
+ (QmlAst.annotmap * (string list * QmlAst.expr * QmlAst.doctype_access_directive * QmlAst.doctype_info list) list) * QmlAst.code
=
let rec remove_expr_doctype (annotmap, acc) e =
match e with
- | Q.Directive (label, `doctype (path, access), [sube], []) ->
+ | Q.Directive (label, `doctype (path, access, info), [sube], []) ->
let annot_e = Annot.annot label in
let tsc_opt =
QmlAnnotMap.find_tsc_opt annot_e annotmap in
@@ -207,7 +207,7 @@ let remove_code_doctype annotmap (qmlAst : QmlAst.code) :
QmlAnnotMap.add_tsc_opt annot_sube tsc_opt annotmap in
let annotmap =
QmlAnnotMap.add_tsc_inst_opt annot_sube tsc_inst_opt annotmap in
- ((annotmap, (path, sube, access) :: acc), sube)
+ ((annotmap, (path, sube, access, info) :: acc), sube)
| _ -> ((annotmap, acc), e) in
let remove_patt_doctype acc e =
QmlAstWalk.Expr.foldmap_down remove_expr_doctype acc e
@@ -239,6 +239,8 @@ struct
*)
type value = {
value_args : string list;
+ value_is_module : bool ;
+ value_opacapi : bool ;
value_ty : ty ;
value_visibility : QmlAst.doctype_access_directive ;
}
@@ -282,7 +284,7 @@ struct
val value :
gamma:QmlTypes.gamma ->
annotmap:QmlAst.annotmap ->
- (string list * QmlAst.expr * QmlAst.doctype_access_directive -> entry)
+ (string list * QmlAst.expr * QmlAst.doctype_access_directive * QmlAst.doctype_info list -> entry)
(**
Types definitions
@@ -319,7 +321,7 @@ struct
let value ~gamma:_ ~annotmap =
let make_entry = make_entry () in
- let value (path, expr, visibility) =
+ let value (path, expr, visibility, _info) =
let label = QmlAst.Label.expr expr in
let filepos = Annot.pos label in
let annot = Annot.annot label in
@@ -334,10 +336,27 @@ struct
end
| _ -> []
in
+ let rec is_module expr =
+ match expr with
+ | QmlAst.Directive (_, `module_, [_e], _) -> true
+ | QmlAst.Directive (_, `doctype(_, _, l), [_e], _) -> List.mem `module_ l
+ | QmlAst.Directive (_, _, [e], _) -> is_module e
+ | QmlAst.Lambda (_, _, e) -> is_module e
+ | QmlAst.LetIn (_, _, e) -> is_module e
+ | _ -> false
+ in
+ let is_module = is_module expr in
+ let opacapi =
+ match expr with
+ | QmlAst.Directive (_, `doctype(_, _, l), [_e], _) -> List.mem `opacapi l
+ | _ -> false
+ in
let code_elt = Value {
value_args = args ;
value_ty = ty ;
value_visibility = visibility ;
+ value_is_module = is_module ;
+ value_opacapi = opacapi
} in
make_entry ~path ~filepos ~code_elt
in
@@ -493,13 +512,19 @@ struct
field, J.Void ;
]
+ method is_module im = bool im
+
+ method opacapi o = bool o
+
method value v =
(*
<!> Opa magic serialize, reverse of alphabetic order between fields
*)
J.Record [
"visibility", self#visibility v.Api.value_visibility ;
"ty", self#ty v.Api.value_ty ;
+ "opacapi", self#opacapi v.Api.value_opacapi ;
+ "is_module", self#is_module v.Api.value_is_module ;
"args", self#args v.Api.value_args ;
]
@@ -637,7 +662,7 @@ let process_qml ~(options : E.opa_options)
*)
let byfile =
List.fold_left
- (fun byfile ((_, expr, _) as value) ->
+ (fun byfile ((_, expr, _, _) as value) ->
let label = QmlAst.Label.expr expr in
let filename = FilePos.get_file (Annot.pos label) in
let entry = make_value value in
View
10 compiler/opalang/opaPrint.ml
@@ -633,12 +633,12 @@ module Classic = struct
| [] -> self#typeident f ident
| _ -> pp f "@[@[<2>%a(%a@])@]" self#typeident ident (list ",@ " self#under_comma#ty) params
method private typeforall f (tvars,rvars,cvars,ty) =
- pp f "@[<2>forall(@[<h>%a%s%a%s%a@]) %a@]"
+ pp f "@[<2>forall(@[<h>%a%s%a%s%a@]) %a@]"
(list ",@ " self#typevar) tvars
(if tvars=[] then "" else ", ")
(list ",@ " self#rowvar) rvars
(if tvars=[] && rvars=[] then "" else ", ")
- (list ",@ " self#colvar) cvars
+ (list ",@ " self#colvar) cvars
self#under_forall#ty ty
method private typesumsugar f l =
pp f "@[<v> %a@]" (list "@ / " self#under_typesum#sum_t) l
@@ -833,7 +833,7 @@ module Classic = struct
| `toplevel -> Format.pp_print_string f "toplevel"
| `from s -> Format.fprintf f "from(%s)" s
| `local s -> pp f "local[%s]" (Ident.to_string s)
- | `doctype (sl, access) ->
+ | `doctype (sl, access, _info) ->
pp f "doctype([%a], %a)" (list ",@ " Format.pp_print_string) sl self#variant access
| `parser_ _ -> Format.pp_print_string f "parser_"
| `xml_parser _ -> Format.pp_print_string f "xml_parser"
@@ -1170,7 +1170,7 @@ module Js = struct
(if tvars=[] then "" else ", ")
(list ",@ " self#rowvar) rvars
(if tvars=[] && rvars=[] then "" else ", ")
- (list ",@ " self#colvar) cvars
+ (list ",@ " self#colvar) cvars
self#under_forall#ty ty
method private typesumsugar f l =
pp f "@[<v>or %a@]" (list "@ or " self#under_typesum#sum_t) l
@@ -1421,7 +1421,7 @@ module Js = struct
| `toplevel -> Format.pp_print_string f "toplevel"
| `from s -> Format.fprintf f "from(%s)" s
| `local s -> pp f "local[%s]" (Ident.to_string s)
- | `doctype (sl, access) ->
+ | `doctype (sl, access, _info) ->
pp f "doctype([%a], %a)" (list ",@ " Format.pp_print_string) sl self#variant access
| `parser_ _ -> Format.pp_print_string f "parser_"
| `xml_parser _ -> Format.pp_print_string f "xml_parser"
View
8 compiler/opalang/opaToQml.ml
@@ -565,7 +565,7 @@ struct
- and directive opa_annot ((c, e, t) as d) =
+ and directive opa_annot ((c, e, t) as d) : QA.expr =
match c, e, t with
| (
`typeof | `opensums | `openrecord | `extendwith | `unsafe_cast
@@ -604,9 +604,11 @@ struct
*)
assert false
- | `opacapi, args, _ -> (
+ | `opacapi, args, _tl -> (
match args with
- | [e] -> expr e
+ | [e] ->
+ let el = [expr e] in
+ QA.Directive ((make_label_from_opa_annot opa_annot), `doctype([], `private_, [`opacapi]), el, [])
| _ ->
(*
The parser ensure that the directive has exactly 1 argument.
View
2 compiler/opalang/opaToQml.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
View
4 compiler/opalang/surfaceAst.ml
@@ -378,10 +378,10 @@ type alpha_renaming_directive =
]
(**
- path * access
+ path * access * info
*)
type documentation_directive =
- [ `doctype of string list * QmlAst.doctype_access_directive ]
+ [ `doctype of string list * QmlAst.doctype_access_directive * QmlAst.doctype_info list ]
type opavalue_directive = [
| `stringifier
View
4 compiler/opalang/surfaceAstCons.ml
@@ -342,8 +342,8 @@ struct
end*)
let open_ ?(label=w()) e1 e2 =
(Directive (`open_, [e1;e2], []), c label)
- let doctype (path:string list) ?(label=w()) ?(access=`public) e1 =
- (Directive (`doctype (path, access), [e1], []), c label)
+ let doctype (path:string list) ?(label=w()) ?(access=`public) ?(info=[]) e1 =
+ (Directive (`doctype (path, access, info), [e1], []), c label)
let string ?(label=w()) l =
(Directive (`string, l, []), c label)
let i18n_lang ?(label=w()) () =
View
2 compiler/opalang/surfaceAstConsSig.ml
@@ -196,7 +196,7 @@ sig
end
(* directive expressions *)
val open_ : ?label:annot -> (ident, [< all_directives > `open_ ] as 'a) expr -> (ident, 'a) expr -> (ident, 'a) expr
- val doctype : string list -> ?label:annot -> ?access:SurfaceAst.access_directive -> (ident, [< all_directives > `doctype ] as 'a) expr -> (ident, 'a) expr
+ val doctype : string list -> ?label:annot -> ?access:SurfaceAst.access_directive -> ?info:(QmlAst.doctype_info list) -> (ident, [< all_directives > `doctype ] as 'a) expr -> (ident, 'a) expr
val string : ?label:annot -> (('a, [> `string ]) expr as 'expr) list -> 'expr
val nonexpansive : ?label:annot -> (('a, [> `nonexpansive ]) expr as 'expr) -> 'expr
val i18n_lang : ?label:annot -> unit -> ('a, [> `i18n_lang ]) expr
View
1 compiler/qmljsimp/imp_Code.ml
@@ -46,6 +46,7 @@ type ('a, 'b) ignored_directive = [
| `may_cps
| `wait
| `backend_ident of string
+| `doctype of (string list * QmlAst.doctype_access_directive * QmlAst.doctype_info list)
(* do not add 'lazy' directive here, or any directive that may avoid some computation,
it will increases the number of directly nested record and letin,
see may_alias_deep_record and may_flatten_letin, if you need to do it *)

0 comments on commit 4495235

Please sign in to comment.
Something went wrong with that request. Please try again.