Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[feature] parser: allowing slicing annotations on local functions

  • Loading branch information...
commit e5775cdbf9c52604b44b642963c53bf9c6e3f2f7 1 parent 6f12a0c
Valentin Gatien-Baron authored
View
38 opalang/syntax/opa_parser.trx
@@ -560,6 +560,7 @@ just_expr10 <-
/** toplevel directive **/
declaration_directives <- (=deco(declaration_directive))*
declaration_directive <-
+ / slicing_directive
/ "@" !strict_spacing deco_ml_identifier_nosp:v function_arguments_nosp?:o
{| let l = Option.default [] o in
let list0 = function
@@ -570,9 +571,6 @@ declaration_directive <-
| _ -> error_directive_number_argument 1 (List.length l) v in
match undecorate v with
| "asynchronous" -> list0 l; Some (`asynchronous_toplevel, l, [])
- | "both" -> list0 l; Some (`side_annotation `both, l, [])
- | "both_implem" -> list0 l; Some (`side_annotation `both_implem, l, [])
- | "client" -> list0 l; Some (`side_annotation `client, l, [])
| "deprecated" -> list1 l; Some (`deprecated, l, [])
| "expand" ->
Some
@@ -582,15 +580,8 @@ declaration_directive <-
| _ -> error_directive_wrong_arguments_type v)
| "opacapi" -> list0 l; Some (`opacapi, l, [])
| "package" -> list0 l; Some (`package, l, [])
- | "prefer_both" -> list0 l; Some (`side_annotation `prefer_both, l, [])
- | "prefer_client" -> list0 l; Some (`side_annotation `prefer_client, l, [])
- | "prefer_server" -> list0 l; Some (`side_annotation `prefer_server, l, [])
| "private" -> list0 l; Some (`private_, l, [])
| "public" -> list0 l; Some (`public, l, [])
- | "publish" -> list0 l; Some (`visibility_annotation (`public `sync), l, [])
- | "publish_async" -> list0 l; Some (`visibility_annotation (`public `async), l, [])
- | "server" -> list0 l; Some (`side_annotation `server, l, [])
- | "server_private" -> list0 l; Some (`visibility_annotation `private_, l, [])
| "specialize" -> Some (`specialize `polymorphic, l, [])
| "specialize_strict" -> Some (`specialize `strict, l, [])
| _ -> None
@@ -604,6 +595,24 @@ declaration_directive <-
| _ -> None
|}
+slicing_directives <- (=deco(slicing_directive))*
+slicing_directive <-
+ / "@" !strict_spacing deco_ml_identifier_nosp:v !"("
+ {|
+ match undecorate v with
+ | "both" -> Some (`side_annotation `both, [], [])
+ | "both_implem" -> Some (`side_annotation `both_implem, [], [])
+ | "client" -> Some (`side_annotation `client, [], [])
+ | "prefer_both" -> Some (`side_annotation `prefer_both, [], [])
+ | "prefer_client" -> Some (`side_annotation `prefer_client, [], [])
+ | "prefer_server" -> Some (`side_annotation `prefer_server, [], [])
+ | "publish" -> Some (`visibility_annotation (`public `sync), [], [])
+ | "publish_async" -> Some (`visibility_annotation (`public `async), [], [])
+ | "server" -> Some (`side_annotation `server, [], [])
+ | "server_private" -> Some (`visibility_annotation `private_, [], [])
+ | _ -> None
+ |}
+
@@ -907,14 +916,17 @@ lambda <-
Only identifiers on the left hand side of recursive values
*)
/** local binding **/
-letin <- pos:pos1 Opa_lexer.REC (=list1pos(rec_binding_pat, and)):l separator pos:pos_f expr:e
+letin <- pos:pos1 slicing_directives:dirs Opa_lexer.REC (=list1pos(rec_binding_pat, and)):l separator pos:pos_f expr:e
{{ let l,posl = l in
push_hint (`same_indents ((pos1::posl) @ [pos_f]));
let l = List.concat_map pat_in_to_simple_bindings l in
+ let l = declaration_directive dirs l in
LetIn (true, l, e)
}}
- / pos:pos1 (binding_pat / do_block):b separator:pos2 expr:e
- {{ push_hint (`same_indent (pos1,pos2)); bind_in_to_expr_in b e }}
+ / pos:pos1 slicing_directives:dirs (binding_pat / do_block):b separator:pos2 expr:e
+ {{ push_hint (`same_indent (pos1,pos2));
+ bind_in_to_expr_in dirs b e
+ }}
and <- spacing pos:p Opa_lexer.AND {{ p }}
(* the ! here is here to prevent code such as {r=123x} to parse as {r=123 x}
View
23 opalang/syntax/parser_utils.ml
@@ -805,12 +805,13 @@ and bind_aux_record label name acc rowvar r =
else
bindings
-let rec create_letins ~label l e2 =
- List.fold_right (fun v acc ->
- match v with
- | `one (s,e1) -> (LetIn (false, [s,e1], acc), copy_label label)
- | `list l -> (LetIn (false, l, acc), copy_label label)
- ) l e2
+let create_letins ~label dirs l e2 =
+ List.fold_right
+ (fun v acc ->
+ match v with
+ | `one (s,e1) -> (LetIn (false, declaration_directive dirs [s,e1], acc), copy_label label)
+ | `list l -> (LetIn (false, declaration_directive dirs l, acc), copy_label label)
+ ) l e2
(* transforms [let (a,b) = e1 in e2] in
* let fresh = e1 in
@@ -818,17 +819,17 @@ let rec create_letins ~label l e2 =
* let b = fresh.f2 in
* e2
*)
-let rec bind_in_to_expr_in binding e2 =
+let rec bind_in_to_expr_in dirs binding e2 =
let (p,e1) = binding in
undecorate (
match p with
- | (PatVar v, label) -> (LetIn (false,[(v,e1)],e2),copy_label label)
- | (PatAny, label) -> (LetIn (false,[(fresh_name (),e1)],e2),copy_label label)
- | (PatCoerce (p,ty),label) -> (bind_in_to_expr_in (p,Cons.E.coerce ~label e1 ty) e2,label)
+ | (PatVar v, label) -> (LetIn (false,declaration_directive dirs [(v,e1)],e2),copy_label label)
+ | (PatAny, label) -> (LetIn (false,declaration_directive dirs [(fresh_name (),e1)],e2),copy_label label)
+ | (PatCoerce (p,ty),label) -> (bind_in_to_expr_in dirs (p,Cons.E.coerce ~label e1 ty) e2,label)
| (_,label) ->
let n = fresh_name () in
let bindings = `one (n,e1) :: List.rev (bind n [] p) in
- create_letins ~label bindings e2
+ create_letins ~label dirs bindings e2
)
let add_recval ~is_recval label (i,e) =
View
5 opalang/syntax/parser_utils.mli
@@ -260,7 +260,10 @@ val map_add_merge : annot -> (string, 'a) expr -> (string, 'a) expr -> (string,
(** Utilities on patterns *)
val if_then_else : ('a, 'b) coerced_expr -> ('a, 'b) expr -> ('a, 'b) expr option -> ('a, 'b) expr_node
(* transform [let pat = expr in expr] into [match expr with pat -> expr] *)
-val bind_in_to_expr_in : string pat * (string, [< all_directives > `coerce ] as 'a) expr -> (string, 'a) expr -> (string, 'a) expr_node
+val bind_in_to_expr_in :
+ (parsing_directive * (string, parsing_directive) expr list * string ty list) label list ->
+ string pat * (string, parsing_directive) expr ->
+ (string, parsing_directive) expr -> (string, parsing_directive) expr_node
val pat_in_to_simple_bindings : (string pat * ((string, [< all_directives > `coerce `recval ]) expr as 'expr)) -> (string * 'expr) list
(** Utils on type definitions *)
View
2  qmlslicer/qmlSimpleSlicer.ml
@@ -356,7 +356,7 @@ let update_call_graph env info =
| Q.Directive (label, (`side_annotation _ | `visibility_annotation _), _, _) ->
let error_context = QmlError.Context.label label in
- QmlError.serror error_context "@[This is an invalid slicer annotation: they can only appear on toplevel bindings (or inside toplevel modules)@]";
+ QmlError.serror error_context "@[This is an invalid slicer annotation: they can only appear on toplevel bindings (or inside toplevel modules) or on function bindings.@]";
context
| Q.Directive (_, `lifted_lambda (_,name), _, _) ->
Please sign in to comment.
Something went wrong with that request. Please try again.