Skip to content
Browse files

[enhance] compiler, runtime, jsast: Simplify the jsast

  • Loading branch information...
1 parent dbb3a62 commit d11fc8e5131fb0de417935054a8a5f637601bbfa @BourgerieQuentin BourgerieQuentin committed Sep 5, 2012
View
1 compiler/opa/opa_Roots.ml
@@ -86,7 +86,6 @@ let roots_for_s3
Opacapi.dom_event_to_opa_event;
Opacapi.Client_code.register_js_code ;
Opacapi.Core_server_code.register_server_code;
- Opacapi.Client_code.register_js_code_elt ;
Opacapi.Client_code.register_css_declaration ;
] in
View
47 compiler/opa/pass_JavascriptCompilation.ml
@@ -96,7 +96,7 @@ let make_root key content =
*)
let client_serialization
~client_roots
- rev_code ( env_js_input : Qml2jsOptions.env_js_input ) =
+ ( env_js_input : Qml2jsOptions.env_js_input ) =
(*
bsl projection: They are no longer roots since the generation
of bypass projection uses Ident.
@@ -107,18 +107,18 @@ let client_serialization
match elts with
| `ast elts ->
List.fold_left (
- fun rev_code (unicity_index, js_elt) ->
+ fun rev_code (_unicity_index, js_elt) ->
let js_elt = JsUtils.globalize_native_ident js_elt in
let js_elt =
JsSerializer.serialize
~client_roots
- ~key:unicity_index
+ ~key:true
js_elt in
js_elt :: rev_code
) rev_code elts
| `string s ->
make_root (Digest.string s) s :: rev_code
- ) rev_code env_js_input.Qml2jsOptions.js_init_contents
+ ) [] env_js_input.Qml2jsOptions.js_init_contents
in
(*
@@ -171,28 +171,16 @@ let parse_js_content ~optimized_conf ~key_prefix ~filename ~content =
let serialize_js_content
~client_roots
- ~key_prefix ~parsed_code
- rev_code
+ ~parsed_code
=
- (*
- We use a counter for distinguing statements from external files.
- We assume that if we parse 2 time the same plugin, or external files,
- the order returned by the parser is the same.
- *)
- let count = ref 0 in
let fold rev_code js_elt =
- let key =
- incr(count) ;
- key_prefix ^ "_item_" ^ (string_of_int !count)
- in
let js_elt =
JsSerializer.serialize
~client_roots
- ~key
js_elt in
js_elt :: rev_code
in
- List.fold_left fold rev_code parsed_code
+ List.fold_left fold [] parsed_code
(*
Process all the code.
@@ -330,25 +318,28 @@ let full_serialize
client.QmlBlender.code
in
- let rev_code : JsSerializer.jsast_code = [] in
+ let rev_code = [] in
let rev_code = List.fold_left
(fun rev_code (ast,key_prefix) ->
match ast with
| `parsed parsed_code ->
- serialize_js_content
- ~client_roots
- ~key_prefix
- ~parsed_code
- rev_code
+ {JsSerializer.
+ ast = serialize_js_content ~client_roots ~parsed_code;
+ plugin = Some key_prefix;
+ } :: rev_code
| `unparsed code_elt ->
- code_elt :: rev_code
+ {JsSerializer.
+ ast = [code_elt];
+ plugin = Some key_prefix;
+ } :: rev_code
) rev_code (List.rev rev_ast) in
(* 3) client code *)
let rev_code =
- client_serialization
- ~client_roots
- rev_code env_js_input
+ {JsSerializer.
+ ast = client_serialization ~client_roots env_js_input;
+ plugin = None
+ } :: rev_code
in
(* compositionality -- save *)
View
2 compiler/opacapi/opacapi.ml
@@ -60,8 +60,6 @@ struct
let (!!) s = !! ("Client_code_" ^ s)
let register_css_declaration = !! "register_css_declaration"
let register_js_code = !! "register_js_code"
- let register_js_code_ast = !! "register_js_code_ast"
- let register_js_code_elt = !! "register_js_code_elt"
let serialize_string_length = !! "serialize_string_length"
end
View
60 compiler/qml2js/qmljs_Serializer.ml
@@ -102,9 +102,8 @@ struct
| RpcDef of string
type jsast_key_ident =
- | KI_key of string
+ | KI_key of jsast_ident
| KI_ident of jsast_ident
- | KI_key_ident of string * jsast_ident
type jsast_code_elt = {
ident : jsast_key_ident ;
@@ -113,7 +112,10 @@ struct
content : jsast_mini_expr list ;
}
- type jsast_code = jsast_code_elt list
+ type jsast_code = {
+ ast : jsast_code_elt list ;
+ plugin : string option ;
+ }
(*
A printer, just for debugging
@@ -132,7 +134,6 @@ struct
let pp_key_ident fmt = function
| KI_key s -> Format.fprintf fmt "{key:%S}" s
| KI_ident s -> Format.fprintf fmt "{ident:%S}" s
- | KI_key_ident (key, ident) -> Format.fprintf fmt "{key:%S ident:%S}" key ident
let pp_definition fmt = function
| `Rpc s -> Format.fprintf fmt "`Rpc %s" s
@@ -155,7 +156,8 @@ struct
incr(i) ;
pp_code_elt fmt elt
in
- Format.pp_list "@\n" pp_code_elt fmt code
+ Option.iter (Format.fprintf fmt "%s@\n") code.plugin;
+ Format.pp_list "@\n" pp_code_elt fmt code.ast
module X =
struct
@@ -369,7 +371,7 @@ struct
let serialize
~client_roots
- ?key
+ ?(key=false)
( elt : JsAst.code_elt ) =
let ident, exprident =
let jsident =
@@ -422,10 +424,10 @@ struct
*)
let ident =
match key with
- | Some key -> KI_key_ident (key, ident)
- | None ->
+ | true -> KI_key ident
+ | false ->
match exprident with
- | Ident.FakeSource key -> KI_key_ident (key, ident)
+ | Ident.FakeSource _ -> KI_key ident
| Ident.Source _ | Ident.Internal _ -> KI_ident ident
in
{
@@ -488,7 +490,6 @@ struct
let ser_key_ident b = function
| S.KI_key key -> Buffer.add_char b '\000'; ser_string b key
| S.KI_ident ident -> Buffer.add_char b '\001'; ser_string b ident
- | S.KI_key_ident (key,ident) -> Buffer.add_char b '\002'; ser_string b key; ser_string b ident
let ser_root b = function
| false -> Buffer.add_char b '\000'
| true -> Buffer.add_char b '\001'
@@ -535,13 +536,16 @@ struct
ser_key_ident b ident;
ser_root b root;
acc
- let ser_code ((b,_) as acc) l =
+ let ser_code ((b,_) as acc) {JsSerializer. ast=l; plugin=_plugin} =
ser_int b (List.length l);
List.fold_left ser_code_elt acc l
- let ser_code l =
+ let ser_ast ((b,_) as acc) l =
+ ser_int b (List.length l);
+ List.fold_left ser_code acc l
+ let ser_ast l =
let b = Buffer.create 20000 in
let acc = (b, []) in
- let (_,l) = ser_code acc l in
+ let (_,l) = ser_ast acc l in
let l =
if Buffer.length b = 0 then l else
let string = !cons#string (Buffer.contents b) in
@@ -663,7 +667,6 @@ struct
match elt.S.ident with
| S.KI_key k -> key k
| S.KI_ident i -> ident i
- | S.KI_key_ident (k, i) -> key_ident k i
in
let root =
let value = !cons#bool elt.S.root in
@@ -687,6 +690,15 @@ struct
let code code = list code_elt code
+ let ast c =
+ list
+ (function
+ | {JsSerializer. ast; plugin=None} ->
+ !cons#record ["ast", code ast]
+ | {JsSerializer. ast; plugin=Some plugin} ->
+ !cons#record ["ast", code ast; "plugin", !cons#string plugin])
+ c
+
(*
The dependencies of the generated code is hard to predict,
because of Hole and DynamicExpr contained in it.
@@ -716,14 +728,14 @@ struct
) ([], []) elt.S.content
in let content = List.rev content
in defs@outs, {elt with S.content}::code
- ) ([], []) code
+ ) ([], []) code.JsSerializer.ast
- let insert_code ~kind ( js_code : JsSerializer.jsast_code ) ( server_code : QmlAst.code ) =
+ let insert_code ~kind ( js_code : JsSerializer.jsast_code list ) ( server_code : QmlAst.code ) =
let () =
#<If:JS_SERIALIZE>
let outputer oc js_code =
let fmt = Format.formatter_of_out_channel oc in
- JsSerializer.pp_code fmt js_code
+ Format.pp_list "@\n" JsSerializer.pp_code fmt js_code
in
let _ = PassTracker.file ~filename:"js_serialize" outputer js_code in
()
@@ -735,18 +747,24 @@ struct
let register_js_code = OpaMapToIdent.val_ Opacapi.Client_code.register_js_code in
let register_js_code = QCons.ident register_js_code in
(* the order in code_elts doesn't matter *)
- let code_elts, e = AdHocSerialize.ser_code js_code in
+ let code_elts, e = AdHocSerialize.ser_ast js_code in
let register_call = !cons#apply register_js_code [ e ] in
List.rev (Q.NewVal (label, [ Ident.next "js_code", register_call ]) :: code_elts)
| `ast ->
let register_js_code =
- OpaMapToIdent.val_ Opacapi.Client_code.register_js_code_ast
+ OpaMapToIdent.val_ Opacapi.Client_code.register_js_code
in
let register_js_code = QCons.ident register_js_code in
(* This is needed because we want that the js code registering be
skipped by cps *)
- let outs, js_code = pull_expr_out js_code in
- let js_code = code (List.rev js_code) in
+ let outs, js_code =
+ List.fold_left
+ (fun (aouts, acode) code ->
+ let outs, ast = pull_expr_out code in
+ aouts@outs, {code with JsSerializer.ast}::acode
+ ) ([], []) js_code
+ in
+ let js_code = ast (List.rev js_code) in
let js_code = !cons#record ["ast", js_code] in
let register_call = !cons#apply register_js_code [ js_code ] in
let register_elt = Ident.next "register_js_ast", register_call in
View
13 compiler/qml2js/qmljs_Serializer.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -86,16 +86,17 @@ sig
type jsast_key_ident =
| KI_key of string
| KI_ident of jsast_ident
- | KI_key_ident of string * jsast_ident
type jsast_code_elt = {
ident : jsast_key_ident ;
definition : [ `Rpc of string | `Type of string | `Nothing ];
root : bool ;
content : jsast_mini_expr list ;
}
-
- type jsast_code = jsast_code_elt list
+ type jsast_code = {
+ ast : jsast_code_elt list;
+ plugin : string option;
+ }
(**
A function for serializing the compile time JsAst. (from jslang).
@@ -106,7 +107,7 @@ sig
*)
val serialize :
client_roots:IdentSet.t ->
- ?key:string ->
+ ?key:bool ->
JsAst.code_elt -> jsast_code_elt
end
@@ -127,5 +128,5 @@ sig
in the packages [stdlib.js], in the module [JsAst].
Keep it synchronized.
*)
- val insert_code : kind:[`ast|`adhoc] -> JsSerializer.jsast_code -> QmlAst.code -> QmlAst.code
+ val insert_code : kind:[`ast|`adhoc] -> JsSerializer.jsast_code list -> QmlAst.code -> QmlAst.code
end
View
46 lib/stdlib/core/core_client_code.opa
@@ -41,15 +41,22 @@
* @opacapi
**/
type Client_code.input =
- {adhoc : list(string); package_ : string}
- / {ast : JsAst.code}
+ {adhoc : list(string); package_ : string}
+/ {ast : llarray(Client_code.unit)}
+
+/**
+ *
+ */
+type Client_code.unit =
+ {ast : JsAst.code; plugin : string}
+/ {ast : JsAst.code}
/**
* @opacapi
**/
type Client_code.output =
- {adhoc : string; package_ : string}
- / {ast : JsAst.code}
+ {adhoc : string; package_ : string}
+/ {ast : JsAst.code}
/**
* {3 Interface}
@@ -65,22 +72,29 @@ Core_client_code =
@private
js_codes = ServerReference.create([]:list(Client_code.output))
+ @private
+ already_seen_plugins = Hashtbl.create(5):Hashtbl.t(string, void)
+
/**
* Register client code on server to be served for all client
* @opacapi
**/
register_js_code(js_code:Client_code.input) : void =
- code =
- match js_code with
- | ~{adhoc package_} ->
- adhoc = String.concat("",adhoc)
- ~{adhoc package_}
- | {ast=_} as v ->
- v
- ServerReference.update(js_codes,List.cons(code,_))
-
- register_js_code_ast(code) =
- @atomic(ServerReference.set(js_codes, [code | ServerReference.get(js_codes)]))
+ update(code) = ServerReference.update(js_codes,List.cons(code,_))
+ match js_code with
+ | ~{adhoc package_} ->
+ adhoc = String.concat("",adhoc)
+ update(~{adhoc package_})
+ | ~{ast} ->
+ /* Only add non already seen plugins */
+ LowLevelArray.iter(
+ | ~{ast} -> update(~{ast})
+ | ~{ast plugin} ->
+ if not(Hashtbl.mem(already_seen_plugins, plugin)) then
+ do Hashtbl.add(already_seen_plugins, plugin, void)
+ update(~{ast})
+ , ast
+ )
/**
* Retrieve client code on server to be served for all client
@@ -89,6 +103,7 @@ Core_client_code =
retrieve_js_codes() : list(Client_code.output) =
l = List.rev(ServerReference.get(js_codes))
do ServerReference.set(js_codes,[])
+ do Hashtbl.clear(already_seen_plugins)
do @assert(l != []) /* making sure this function is called at most once */
l
}}
@@ -128,7 +143,6 @@ Core_server_code =
}}
@opacapi Client_code_register_js_code = Core_client_code.register_js_code
-@opacapi Client_code_register_js_code_ast = Core_client_code.register_js_code_ast
@opacapi Core_server_code_register_server_code = Core_server_code.register_server_code
#<Ifstatic:OPA_BACKEND_QMLJS>
View
23 lib/stdlib/core/js/jsast_cleaning.opa
@@ -198,8 +198,7 @@ type JsCleaning.marked = JsIdentSet.t
stack =
match code_elt.i with
| {k=_} -> stack
- | {~i}
- | {~i k=_} ->
+ | {~i} ->
closure_keys = Closure.deps_of_var_for_cleaning(i)
//do List.iter(closure_key -> jlog("CLIENT: {ident} is using ident {closure_key}"), closure_keys)
List.append(closure_keys, stack)
@@ -213,8 +212,7 @@ type JsCleaning.marked = JsIdentSet.t
ServerReference.get(code_elt.r)
|| (
match code_elt.i with
- | {~i}
- | {~i k=_} ->
+ | {~i} ->
is_root_ident(i)
| { k = _ } -> true
)
@@ -269,8 +267,7 @@ type JsCleaning.marked = JsIdentSet.t
@private unsafe_get_ident(key_ident:JsAst.key_ident) =
match key_ident with
| {~i} -> i
- | {~i k=_} -> i
- | ~{k} -> error("unsafe_get_ident on {k}")
+ | ~{k} -> k
/**
* Initialize the structure needing for marking
@@ -280,9 +277,10 @@ type JsCleaning.marked = JsIdentSet.t
unicity = infos.unicity
not_uniq =
match code_elt.i : JsAst.key_ident with
- | {~k}
- | {~k i=_} -> StringSet.mem(k, unicity)
- | {i=_} -> false
+ | {k=i} ->
+ StringSet.mem(i, unicity)
+ | {i=_} ->
+ false
if not_uniq
then
do ServerReference.set(code_elt.r, false)
@@ -311,14 +309,11 @@ type JsCleaning.marked = JsIdentSet.t
~{ infos with client_roots }
| { ~k } ->
+ do JsIdent.define(k)
+ do Hashtbl.add(elements, k, code_elt)
unicity = StringSet.add(k, unicity)
~{ infos with client_roots unicity }
- | ~{ k i } ->
- do JsIdent.define(i)
- do Hashtbl.add(elements, i, code_elt)
- unicity = StringSet.add(k, unicity)
- ~{ infos with unicity client_roots }
infos
JsAst.fold_code(fold, code, infos)
View
3 lib/stdlib/core/jsast_typedef.opa
@@ -79,9 +79,8 @@ type JsAst.content = llarray(JsAst.mini_expr)
* The content contains the complete code_element (header and concrete syntax include)
**/
type JsAst.key_ident =
- { k : string }
+ { k : JsAst.ident }
/ { i : JsAst.ident }
- / { k : string ; i : JsAst.ident }
/**
* The run-time representation of a js top-level declaration.
View
11 lib/stdlib/core/web/server/client_code.opa
@@ -46,7 +46,6 @@ import stdlib.core.{js, rpc.core, pack}
match D.unpack(key_ident_code, input.binary, input.pos) with
| {success=(pos,[{Coded=[({Byte=0},[{String=k}])]}])} -> {success=({input with ~pos},{~k})}
| {success=(pos,[{Coded=[({Byte=1},[{String=i}])]}])} -> {success=({input with ~pos},{~i})}
- | {success=(pos,[{Coded=[({Byte=2},[{String=k},{String=i}])]}])} -> {success=({input with ~pos},~{k; i})}
| {success=(_,[{Coded=[({Byte=n},_)]}])} -> {failure="Client_code.unser_key_ident: bad code {n}"}
| {success=data} -> {failure="Client_code.unser_key_ident: bad unpack data {data}"}
| {~failure} -> {~failure}
@@ -169,12 +168,6 @@ import stdlib.core.{js, rpc.core, pack}
LowLevelArray.empty
/**
- * Register a code_elt.
- **/
- register_js_code_elt(js_elt : JsAst.code_elt) : void =
- Core_client_code.register_js_code({ast=@llarray(js_elt)})
-
- /**
* Obtain client processed code as a string (rename and cleaned, but not minified)
**/
retrieve_js_file() : string =
@@ -208,10 +201,6 @@ import stdlib.core.{js, rpc.core, pack}
* {1 Functions exported to the global namespace}
*/
-/* client code */
-@opacapi Client_code_register_js_code_elt = Client_code.register_js_code_elt
-Client_code_register_css_file = Client_code.register_css_file
-
/**
* Some export for pass "AddCSS"
*/

0 comments on commit d11fc8e

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