Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[fix] libbsl: rename idents in js new syntax.

When we read a file with directives, we rename all registered
identifiers to their fully qualified names. Thus, in bslFoo.js,

    /**
     * @register {int -> int}
     */
    function toto(a) {
        return a + toto(a);
    }

becomes

    function BslFoo_toto(a) {
        return a + BslFoo_toto(a);
    }
  • Loading branch information...
commit f93b0bddd13ad88435e5b78f7ef8b31ef002e9fc 1 parent 8b6366e
@arthuraa arthuraa authored
View
4 compiler/libbsl/_tags
@@ -43,4 +43,6 @@
<bslOcaml.ml> : with_mlstate_debug
<bslConf.ml> : with_mlstate_debug
-<bslJsParse.ml>: use_jslang
+<bslJsParse.ml*>: use_jslang
+<bslJs.ml*>: use_jslang
+<bslDirectives.ml*>: use_jslang
View
2  compiler/libbsl/bslDirectives.ml
@@ -240,7 +240,7 @@ module Js = struct
*)
type definition =
- | Regular of string
+ | Regular of JsIdent.t
| Inline of string
type t =
View
73 compiler/libbsl/bslJs.ml
@@ -35,6 +35,7 @@ let (|>) = InfixOperator.(|>)
module BPI = BslPluginInterface
module D = BslDirectives
module DJ = D.Js
+module J = JsAst
type filename = string
type contents = string
@@ -47,7 +48,7 @@ type js_file = FBuffer.t
type js_decorated_file = {
directives: (FilePos.pos * BslTags.t * DJ.t) list;
- contents: contents;
+ contents: J.code;
filename: filename;
}
@@ -542,9 +543,8 @@ let fold_source_elt_classic ~dynloader_interface ~filename ~lang
in
env, js_file
-let env_add_file_line ~filename env js_file =
- let js_file = FBuffer.printf js_file "// file %S, line 1@\n" filename in
- js_file, env
+let add_file_line ~filename js_file =
+ FBuffer.printf js_file "// file %S, line 1@\n" filename
let fold_decorated_file_classic ~dynloader_interface ~lang env decorated_file =
let filename = decorated_file.D.filename in
@@ -554,7 +554,7 @@ let fold_decorated_file_classic ~dynloader_interface ~lang env decorated_file =
let env = env_add_module nopos implementation None env in
(* For each file, we create a FBuffer, updated in a fold on decorated lines *)
let js_file = fbuffer () in
- let js_file, env = env_add_file_line ~filename env js_file in
+ let js_file = add_file_line ~filename js_file in
let env, js_file =
List.fold_left (fold_source_elt_classic ~dynloader_interface ~filename ~lang) (env, js_file) source
@@ -584,7 +584,7 @@ let fold_decorated_file_classic ~dynloader_interface ~lang env decorated_file =
updated map of bypasses that have been defined in this file, so
they can be bound later *)
let fold_source_elt_doc_like ~dynloader_interface ~filename ~lang
- (env, local_defs) (pos, tags, directive) =
+ (env, renaming) (pos, tags, directive) =
match directive with
| DJ.OpaTypeDef (skey, params) ->
if not tags.BslTags.opaname then
@@ -637,7 +637,7 @@ let fold_source_elt_doc_like ~dynloader_interface ~filename ~lang
BslPluginInterface.apply_register_type
dynloader_interface.BslPluginInterface.register_type rt;
let env = { env with ty_spec_map; } in
- env, local_defs
+ env, renaming
| DJ.ExternalTypeDef (skey, params) ->
let rt_ks = env_rp_ks env skey in
@@ -678,30 +678,30 @@ let fold_source_elt_doc_like ~dynloader_interface ~filename ~lang
BslPluginInterface.apply_register_type
dynloader_interface.BslPluginInterface.register_type rt;
let env = { env with ty_spec_map; } in
- env, local_defs
+ env, renaming
| DJ.Module skey ->
- env_add_module pos skey None env, local_defs
+ env_add_module pos skey None env, renaming
| DJ.EndModule ->
- env_add_endmodule pos env, local_defs
+ env_add_endmodule pos env, renaming
| DJ.Register (skey, implementation, bslty) ->
let rp_ks = env_rp_ks env skey in
let rp_ty = env_map_ty_reference_for_opa env pos skey bslty in
let parsed_t = BslTags.parsed_t tags in
let key = BslKey.normalize (String.concat "." rp_ks) |> BslKey.to_string in
- let keyed_implementation, local_defs =
+ let keyed_implementation, renaming =
(* For now, we try to export the bypasses in code with the same
name as they would have using the classic syntax, just to make
sure that nothing will go wrong *)
match implementation with
| DJ.Regular name ->
- let ki = env_rp_implementation env skey in
- ki, StringMap.add key (ki, name) local_defs
+ let ki = JsCons.Ident.native (env_rp_implementation env skey) in
+ JsIdent.to_string ki, JsIdentMap.add name ki renaming
| DJ.Inline source ->
(* Since it is just an alias in this case, we don't need to bind it *)
- source, local_defs
+ source, renaming
in
let rp_ips = [ lang, filename, parsed_t, keyed_implementation ] in
let rp = { BslPluginInterface.
@@ -716,7 +716,35 @@ let fold_source_elt_doc_like ~dynloader_interface ~filename ~lang
} in
BslPluginInterface.apply_register_primitive
dynloader_interface.BslPluginInterface.register_primitive rp;
- env, local_defs
+ env, renaming
+
+let rename renaming code =
+ List.map (fun stm ->
+ JsWalk.TStatement.map
+ (fun stm ->
+ match stm with
+ | J.Js_function (pos, ident, args, body) -> (
+ match JsIdentMap.find_opt ident renaming with
+ | Some ident' -> J.Js_function (pos, ident', args, body)
+ | None -> stm
+ )
+ | J.Js_var (pos, ident, def) -> (
+ match JsIdentMap.find_opt ident renaming with
+ | Some ident' -> J.Js_var (pos, ident', def)
+ | None -> stm
+ )
+ | _ -> stm
+ )
+ (fun expr ->
+ match expr with
+ | J.Je_ident (pos, ident) -> (
+ match JsIdentMap.find_opt ident renaming with
+ | Some ident' -> J.Je_ident (pos, ident')
+ | None -> expr
+ )
+ | _ -> expr
+ ) stm
+ ) code
let fold_decorated_file_doc_like ~dynloader_interface ~lang env decorated_file =
let filename = decorated_file.filename in
@@ -725,16 +753,15 @@ let fold_decorated_file_doc_like ~dynloader_interface ~lang env decorated_file =
(* we add a module for each file *)
let env = env_add_module nopos implementation None env in
+ let fold = fold_source_elt_doc_like ~dynloader_interface ~filename ~lang in
+ let init_state = (env, JsIdentMap.empty) in
+ let env, renaming = List.fold_left fold init_state directives in
+
(* For each file, we create a FBuffer, updated in a fold on decorated lines *)
let js_file = fbuffer () in
- let js_file, env = env_add_file_line ~filename env js_file in
- let js_file = FBuffer.add js_file decorated_file.contents in
- let fold = fold_source_elt_doc_like ~dynloader_interface ~filename ~lang in
- let init_state = (env, StringMap.empty) in
- let env, local_defs = List.fold_left fold init_state directives in
- let js_file = StringMap.fold (fun _key (lhs, rhs) js_file ->
- FBuffer.printf js_file "var %s = %s;\n" lhs rhs
- ) local_defs js_file in
+ let js_file = add_file_line ~filename js_file in
+ let contents = rename renaming decorated_file.contents in
+ let js_file = FBuffer.printf js_file "%a" JsPrint.pp#code contents in
let js_code = FBuffer.contents js_file in
let file_js_code = filename, js_code in
let rev_files_js_code = file_js_code :: env.rev_files_js_code in
View
2  compiler/libbsl/bslJs.mli
@@ -36,7 +36,7 @@ type contents = string
type js_decorated_file = {
directives: (FilePos.pos * BslTags.t * BslDirectives.Js.t) list;
- contents: contents;
+ contents: JsAst.code;
filename: filename;
}
View
33 compiler/libbsl/bslJsParse.ml
@@ -32,6 +32,11 @@ type tag = string
type message = string
type pos = FilePos.pos
+type parsed_file = {
+ directives: (FilePos.pos * BslTags.t * BslDirectives.Js.t) list;
+ code: JsAst.code;
+}
+
let whitespace = Str.regexp "[ \t]*"
(** When trying to interpret a comment as a bsl directive, we do the
@@ -244,7 +249,8 @@ let extract_register implementation =
let (_, ty) = BslRegisterParser.parse_bslregisterparser_bslty ty in
let name =
try
- `success (String.trim (Str.matched_group 2 args))
+ `success (JsCons.Ident.native
+ (String.trim (Str.matched_group 2 args)))
with
Not_found ->
match implementation with
@@ -278,7 +284,7 @@ let extract_register implementation =
in
match name, definition with
| `success name, `success definition ->
- `found (BD.Register (name, definition, ty))
+ `found (BD.Register (JsIdent.to_string name, definition, ty))
| `success _, `error message
| `error message, `success _ -> `wrong_format (pos, message)
| `error m1, `error m2 -> `wrong_format (pos, Printf.sprintf "%s, %s" m1 m2)
@@ -345,30 +351,35 @@ let filter_lines lines = List.filter_map (fun line ->
| JsLex.CommentTag (pos, tag, args) -> Some (pos, tag, args)
) lines
-let rec doc_comment acc code =
+let rec analyze_comments directives code =
match code with
| J.Js_comment (_, J.Jc_doc (_, lines)) :: rest -> (
let tags = filter_lines lines in
let implementation, rest = match rest with
| J.Js_function (_, ident, args, _) :: rest
| J.Js_var (_, ident, Some (J.Je_function (_, _, args, _))) :: rest ->
- `func (JsIdent.to_string ident, args), rest
+ `func (ident, args), rest
| J.Js_var (_, ident, _) :: rest ->
- `var (JsIdent.to_string ident), rest
+ `var ident, rest
| _ -> `none, rest in
match maybe_extract_directive implementation tags with
- | NoOccurrences -> doc_comment acc rest
+ | NoOccurrences -> analyze_comments directives rest
| Error e -> `error e
| Found (pos, bsl_tags, d) ->
- doc_comment ((pos, bsl_tags, d) :: acc) rest
+ analyze_comments ((pos, bsl_tags, d) :: directives) rest
)
- | _ :: rest -> doc_comment acc rest
- | [] -> `success (List.rev acc)
+ | _ :: rest -> analyze_comments directives rest
+ | [] -> `success (List.rev directives)
+
+let process code =
+ match analyze_comments [] code with
+ | `error e -> `error e
+ | `success directives -> `success {directives; code}
let parse_file filename =
try
let code = JsParse.File.code ~throw_exn:true filename in
- doc_comment [] code
+ process code
with
JsParse.Exception e ->
`error (Format.to_string JsParse.pp e)
@@ -376,7 +387,7 @@ let parse_file filename =
let parse_string ?filename content =
try
let code = JsParse.String.code ?filename ~throw_exn:true content in
- doc_comment [] code
+ process code
with
JsParse.Exception e ->
`error (Format.to_string JsParse.pp e)
View
10 compiler/libbsl/bslJsParse.mli
@@ -20,12 +20,18 @@
@author Arthur Azevedo de Amorim
*)
+type parsed_file = {
+ directives: (FilePos.pos * BslTags.t * BslDirectives.Js.t) list;
+ code: JsAst.code;
+}
+
+
(** [parse_file filename] attempts to read a js file [filename] and parse
its directives according to the doc-like syntax *)
val parse_file :
string ->
[ `error of string
- | `success of (FilePos.pos * BslTags.t * BslDirectives.Js.t) list ]
+ | `success of parsed_file ]
(** [parse_string string] attempts to read js code in [string] and parse
its directives according to the doc-like syntax *)
@@ -33,4 +39,4 @@ val parse_string :
?filename:string ->
string ->
[ `error of string
- | `success of (FilePos.pos * BslTags.t * BslDirectives.Js.t) list ]
+ | `success of parsed_file ]
View
2  compiler/libbsl/bslRegisterLib.ml
@@ -1568,7 +1568,7 @@ let parse_js_bypass_file_new pprocess filename =
FilePos.add_file filename contents;
match BslJsParse.parse_string ~filename contents with
| `error e -> OManager.error "%s" e
- | `success directives ->
+ | `success {BslJsParse. directives; code = contents} ->
{ BslJs. filename; contents; directives; }
let parse_js_bypass_file pprocess options filename =
Please sign in to comment.
Something went wrong with that request. Please try again.