Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[cleanup] garbage: collecting some directives

  • Loading branch information...
commit 43a556ef74f55237081c6968b83643352c53de24 1 parent 12488cf
Valentin Gatien-Baron authored
View
11 libqmlcompil/qmlAst.ml
@@ -740,7 +740,7 @@ type cps_directive = [
the third element is the position of the application, if any
*)
- | `asynchronous_toplevel
+ | `async
(**
Tag for using partially the toplevel-concurrency mode when the option is not activated.
As we have no way to put directives at toplevel in the AST, we count on the luck and the
@@ -769,14 +769,6 @@ type exception_directive = [
application is the return value of the directive *)
]
-type deprecated_directive = [
- | `box
- | `unbox
- | `unbox_option
- | `enrich
- | `eval
-]
-
(** Used for extend magic function. *)
type opavalue_directive = [
| `stringifier (** Extend OpaValue.to_string *)
@@ -810,7 +802,6 @@ type qml_directive = [
| slicer_directive
| thread_context_directive
| type_directive
- | deprecated_directive
| `closure_create of Ident.t * int * ((ty, unit) QmlGenericScheme.tsc) option
(** definition of a closure with its implementation, arity, and type scheme *)
View
12 libqmlcompil/qmlDirectives.ml
@@ -260,7 +260,7 @@ let ty directive exprs tys =
| `callcc -> Ty.callcc ()
| `cps_stack_lambda _
| `cps_stack_apply _
- | `asynchronous_toplevel
+ | `async
| `may_cps
| `apply_cont
-> Ty.id ()
@@ -404,16 +404,6 @@ let ty directive exprs tys =
| `recval ->
Ty.id ()
- (* === *)
- (* Deprecated directives : TODO: remove from QmlAst *)
- | `box
- | `unbox
- | `unbox_option
- | `enrich
- | `eval
- ->
- assert false
-
(* utils *)
let create_lazy_record_arguments = function
View
7 libqmlcompil/qmlPrint.ml
@@ -103,11 +103,6 @@ let directive (d:QmlAst.qml_directive) =
| `openrecord -> "@openrecord"
| `assert_ -> "@assert"
| `typeof -> "@typeof"
- | `box -> "@box"
- | `unbox -> "@unbox"
- | `unbox_option -> "@unbox_option"
- | `enrich -> "@enrich"
- | `eval -> "@eval"
| `atomic -> "@atomic"
| `immovable -> "@immovable"
| `thread_context -> "@thread_context"
@@ -143,7 +138,7 @@ let directive (d:QmlAst.qml_directive) =
| `fun_action (Some Q.Deserialize) -> "@fun_action[Deserialize]"
| `cps_stack_lambda _ -> "@cps_stack_lambda"
| `cps_stack_apply _ -> "@cps_stack_apply"
- | `asynchronous_toplevel -> "@asynchronous"
+ | `async -> "@async"
| `sliced_expr -> "@sliced_expr"
| `may_cps -> "@may_cps"
| `stringifier -> "@stringifier"
View
9 opalang/opaPrint.ml
@@ -404,22 +404,16 @@ object (self)
| `magic_do -> Format.pp_print_string f "magic_do"
| `typeof -> Format.pp_print_string f "typeof"
| `assert_ -> Format.pp_print_string f "assert_"
- | `assert_message s -> pp f "assert_message[%s]" s
- | `ensure -> Format.pp_print_string f "ensure"
- | `ensure_message s -> pp f "ensure_message[%s]" s
| `deprecated -> pp f "deprecated"
| `todo -> pp f "todo"
- | `warning s -> pp f "warning[%s]" s
| `server_entry_point -> Format.pp_print_string f "server_entry_point"
| `spawn -> Format.pp_print_string f "spawn"
| `wait -> Format.pp_print_string f "wait"
- | `lazy_ -> Format.pp_print_string f "lazy_"
- | `force -> Format.pp_print_string f "force"
| `callcc -> Format.pp_print_string f "callcc"
| `atomic -> Format.pp_print_string f "atomic"
| `thread_context -> Format.pp_print_string f "thread_context"
| `with_thread_context -> Format.pp_print_string f "with_thread_context"
- | `asynchronous_toplevel -> Format.pp_print_string f "asynchronous"
+ | `async -> Format.pp_print_string f "async"
| `side_annotation _ -> Format.pp_print_string f "side_annotation"
| `visibility_annotation _ -> Format.pp_print_string f "visibility_annotation"
| `static_content (s, eval) -> pp f "static_content[%s][%b]" s eval
@@ -441,7 +435,6 @@ object (self)
| `module_ -> Format.pp_print_string f "module_"
| `module_field_lifting -> Format.pp_print_string f "module_field_lifting"
| `warncoerce -> Format.pp_print_string f "warncoerce"
- | `translate -> Format.pp_print_string f "translate"
| `js_ident -> Format.pp_print_string f "js_ident"
| `open_ -> Format.pp_print_string f "open_"
| `toplevel_open -> Format.pp_print_string f "toplevel_open"
View
26 opalang/opaToQml.ml
@@ -540,10 +540,10 @@ struct
| (
`typeof | `opensums | `openrecord | `unsafe_cast
| `nonexpansive | `doctype _ | `module_ | `module_field_lifting
- | `spawn | `wait | `callcc | `atomic | `js_ident | `expand _
+ | `spawn | `wait | `atomic | `callcc | `js_ident | `expand _
| `create_lazy_record | `assert_ | `fail
| `thread_context
- | `asynchronous_toplevel
+ | `async
| `throw | `catch | `tracker _
| `with_thread_context
| `sliced_expr
@@ -552,12 +552,10 @@ struct
| `deprecated
| `todo
| `recval
+ | #SA.opavalue_directive
| #SA.distribution_directive
- ) as variant, el, [] ->
- let el = List.map expr el in
- QA.Directive ((make_label_from_opa_annot opa_annot), variant, el, [])
- | (`stringifier | `comparator | `serializer | `xmlizer)
- as variant, el, tl ->
+ | `llarray
+ ) as variant, el, tl ->
let el = List.map expr el in
let tl = List.map ty tl in
QA.Directive ((make_label_from_opa_annot opa_annot), variant, el, tl)
@@ -566,11 +564,6 @@ struct
let t = ty t in
let e = expr e in
QA.Coerce ((make_label_from_opa_annot opa_annot), e, t)
- | `llarray, exprs, tys ->
- let tys = List.map ty tys in
- let exprs = List.map expr exprs in
- QA.Directive
- ((make_label_from_opa_annot opa_annot), `llarray, exprs, tys)
| `coerce, _, _ -> assert false
| `warncoerce, _, _ ->
@@ -617,15 +610,6 @@ struct
| (`magic_to_string | `magic_to_xml) as variant, [e], []
when not keep_magic_directive ->
apply_directive opa_annot (directive_variant_to_string variant) e
- | (
- `assert_ | `magic_to_string | `fun_action | `magic_to_xml
- | `deprecated | `todo
- ), l, _ -> (
- Format.eprintf "%a%!" Arg.pp_print_directive d;
- match l with
- | [] -> assert false
- | e :: _ -> fail e "directive: supposed to be taken care of already"
- )
| #SA.all_directives, e :: _, _ ->
Format.eprintf "%a%!" Arg.pp_print_directive d;
View
12 opalang/surfaceAst.ml
@@ -300,11 +300,6 @@ type magic_directive =
]
type error_directive =
[ `assert_
- | `assert_message of string
-(* TODO: remove ensure* directives (unused) *)
- | `ensure
- | `ensure_message of string
- | `warning of string
]
type coding_directive = [
| `deprecated
@@ -316,16 +311,14 @@ type insert_server_directive =
type concurrency_directive =
[ `spawn
| `wait
- | `lazy_
- | `force
| `callcc
| `atomic
| `thread_context
| `with_thread_context
| `throw
| `catch
- | `asynchronous_toplevel
| `may_cps
+ | `async
]
type distribution_directive = QmlAst.slicer_directive
type file_inclusion_directive =
@@ -358,8 +351,7 @@ type type_directive =
| `warncoerce
]
type other_directive =
- [ `translate
- | `fun_action
+ [ `fun_action
| `js_ident
| `sliced_expr (** the expressions is a two elements containing first the client expression and then the server expression *)
| `llarray
View
13 opalang/syntax/opa_parser.trx
@@ -564,7 +564,7 @@ declaration_directive_any <-
declaration_directive1 <-
/ "deprecated" {{ `deprecated }}
declaration_directive0 <-
- / "asynchronous" {{ `asynchronous_toplevel }}
+ / "async" {{ `async }}
/ "opacapi" {{ `opacapi }}
/ "package" {{ `package }}
/ "private" {{ `private_ }}
@@ -620,15 +620,12 @@ directive1 <-
/ "assert" {{ `assert_ }}
/ "atomic" {{ `atomic }}
/ "callcc" {{ `callcc }}
- / "ensure" {{ `ensure }}
- / "force" {{ `force }}
/ "js_ident" {{ `js_ident }}
/ "may_cps" {{ `may_cps }}
/ "nonexpansive" {{ `nonexpansive }}
/ "openrecord" {{ `openrecord }}
/ "opensums" {{ `opensums }}
/ "throw" {{ `throw }}
- / "translate" {{ `translate }}
/ "typeof" {{ `typeof }}
/ "unsafe_cast" {{ `unsafe_cast }}
/ "wait" {{ `wait }}
@@ -638,18 +635,12 @@ directive2 <-
/ "deprecated" {{ `deprecated }}
/ "with_thread_context" {{ `with_thread_context }}
-directive2str <-
- / "assert_message" {{ fun x -> `assert_message x }}
- / "ensure_message" {{ fun x -> `ensure_message x }}
- / "warning" {{ fun x -> `warning x }}
-
directive1str <-
/ ("static_source_content" / "static_binary_content") {{ fun x -> `static_content (x, true) }}
/ "compiletime" {{ fun x -> `compiletime x }}
directive1rec <-
/ "lazy_record" {{ `create_lazy_record }}
- / "lazy" {{ `lazy_ }}
/ "spawn" {{ `spawn }}
directive1or2str <-
@@ -680,8 +671,6 @@ directive <-
{{ Directive (v str,[],[]) }}
/ "@" (=exact_ident(directive1rec)):v Opa_lexer.lpar_nosp (=deco(just_record)):e rpar
{{ Directive (v,[e],[]) }}
- / "@" (=exact_ident(directive2str)):v Opa_lexer.lpar_nosp string:str comma expr:e rpar
- {{ Directive (v str,[e],[]) }}
/ "@" (=exact_ident(directive2)):v Opa_lexer.lpar_nosp expr:e1 comma expr:e2 rpar
{{ Directive (v,[e1;e2],[]) }}
/ "@" (=exact_ident(directive1or2str)):v Opa_lexer.lpar_nosp string:str (comma expr:e {{ [e] }} / _succeed {{ [] }}):el rpar
View
4 opatop/opaTopEval.ml
@@ -57,7 +57,7 @@ type env = V.t IdentMap.t
type ('a, 'b) ignored_directive = [
| QmlAst.type_directive
-| `asynchronous_toplevel
+| `async
| `atomic
| `fun_action of 'a
| `nonexpansive
@@ -70,7 +70,7 @@ type ('a, 'b) ignored_directive = [
let rec traverse_ignore expr =
match expr with
- | Q.Directive (_, #ignored_directive, [expr], _) -> traverse_ignore expr
+ | Q.Directive (_, #ignored_directive, [expr], _)
| Q.Coerce (_, expr, _) -> traverse_ignore expr
| _ -> expr
View
8 qmlcps/qmlCpsRewriter.ml
@@ -1094,7 +1094,7 @@ let il_of_qml ?(can_skip_toplvl=false) (env:env) (private_env:private_env) (expr
| Q.Directive (_, `catch, _, _) ->
failwith "Internal error: directive @catch should have 2 arguments"
- | Q.Directive (_, `asynchronous_toplevel, _, _) ->
+ | Q.Directive (_, `async, _, _) ->
failwith "Internal error: presence of @asynchronous directive in an expression"
| Q.Directive (_, `partial_apply _, _, _) -> assert false
@@ -1379,7 +1379,7 @@ let qml_of_il ~toplevel_cont (env:_) (private_env:private_env) (term:IL.term) =
| IL.Directive (`restricted_bypass _, _, _) -> assert false (* rewrited in a expanded_bypass after qml -> IL or removed by hoisting *)
- | IL.Directive (`asynchronous_toplevel, _, _) ->
+ | IL.Directive (`async, _, _) ->
(* at toplevel only, checked by qml -> IL *)
assert false
@@ -1524,7 +1524,7 @@ let code_elt (env:env) (private_env:private_env) code_elt =
let immediate_value_or_barrier ?(can_skip_toplvl=false) () =
let is_asynchronous, expr =
match expr with
- | Q.Directive (_, `asynchronous_toplevel, [e], _) -> true, e
+ | Q.Directive (_, `async, [e], _) -> true, e
| _ -> false, expr
in
let private_env, il_term = il_of_qml ~can_skip_toplvl:can_skip_toplvl env private_env expr in
@@ -1700,7 +1700,7 @@ let code_elt (env:env) (private_env:private_env) code_elt =
| _ -> assert false
end
- | Q.Directive (_, `asynchronous_toplevel, _, _) -> immediate_value_or_barrier ()
+ | Q.Directive (_, `async, _, _) -> immediate_value_or_barrier ()
| Q.Directive (_, `llarray, _, _) -> immediate_value_or_barrier ~can_skip_toplvl:true ()
View
2  qmlflat/flat/flat_ExprGeneration.ml
@@ -42,7 +42,7 @@ module P = Qml2ocamlOptions
*)
type ('a, 'b, 'c, 'd, 'e) assume_traverse = [
| QmlAst.type_directive
-| `asynchronous_toplevel
+| `async
| `atomic
| `fun_action of 'a
| `nonexpansive
View
2  qmljsimp/imp_Code.ml
@@ -35,7 +35,7 @@ module P = Imp_PatternAnalysis
type ('a, 'b) ignored_directive = [
| QmlAst.type_directive
-| `asynchronous_toplevel
+| `async
| `atomic
| `fun_action of 'a
| `nonexpansive
View
2  utils/emacs/opa-mode.el
@@ -67,7 +67,7 @@
'("type" "if" "match" "do" "parser" "xml_parser" "database" "server" "rec" "and" "as" "css" "db" "with" "val"
"import" "import-plugin" "package")))
(defconst opa-directives
- '("xml" "typeval" "static_content_directory" "static_resource_directory" "static_source_content" "static_binary_content" "static_include_directory" "catch" "client" "fail" "typeof" "lazy" "lazy_record" "thread_context" "with_thread_context" "throw" "track" "wrap" "unwrap" "callcc" "uncps" "atomic" "js_ident" "expand" "spawn" "wait" "server" "unsafe_cast" "toplevel" "assert" "opensums" "publish" "publish_async" "both" "prefer_client" "prefer_server" "prefer_both" "both_implem" "abstract" "private" "public" "package" "nonexpansive" "asynchronous" "compiletime" "sliced_expr" "may_cps" "llarray" "specialize" "specialize_strict" "server_private" "opacapi" "stringifier" "xmlizer" "serializer" "comparator" "deprecated" "todo"))
+ '("xml" "typeval" "static_content_directory" "static_resource_directory" "static_source_content" "static_binary_content" "static_include_directory" "catch" "client" "fail" "typeof" "lazy" "lazy_record" "thread_context" "with_thread_context" "throw" "track" "wrap" "unwrap" "callcc" "uncps" "atomic" "js_ident" "expand" "spawn" "wait" "server" "unsafe_cast" "toplevel" "assert" "opensums" "publish" "publish_async" "both" "prefer_client" "prefer_server" "prefer_both" "both_implem" "abstract" "private" "public" "package" "nonexpansive" "async" "compiletime" "sliced_expr" "may_cps" "llarray" "specialize" "specialize_strict" "server_private" "opacapi" "stringifier" "xmlizer" "serializer" "comparator" "deprecated" "todo"))
(defun match-opa-tuple-type (limit)
(when (and (looking-at "( *")
Please sign in to comment.
Something went wrong with that request. Please try again.