|
@@ -16,14 +16,32 @@
|
|
* along with this program; if not, write to the Free Software
|
|
* along with this program; if not, write to the Free Software
|
|
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
*)
|
|
*)
|
|
|
|
+open Ast
|
|
open Type
|
|
open Type
|
|
open Common
|
|
open Common
|
|
|
|
|
|
|
|
+type pos = Ast.pos
|
|
|
|
+
|
|
|
|
+type sourcemap = {
|
|
|
|
+ mutable source_last_line : int;
|
|
|
|
+ mutable source_last_col : int;
|
|
|
|
+ mutable source_last_file : int;
|
|
|
|
+
|
|
|
|
+ mutable print_comma : bool;
|
|
|
|
+ mutable output_last_col : int;
|
|
|
|
+ mutable output_current_col : int;
|
|
|
|
+
|
|
|
|
+ sources : (string) DynArray.t;
|
|
|
|
+ sources_hash : (string, int) Hashtbl.t;
|
|
|
|
+ mappings : Buffer.t;
|
|
|
|
+}
|
|
|
|
+
|
|
type ctx = {
|
|
type ctx = {
|
|
com : Common.context;
|
|
com : Common.context;
|
|
buf : Buffer.t;
|
|
buf : Buffer.t;
|
|
packages : (string list,unit) Hashtbl.t;
|
|
packages : (string list,unit) Hashtbl.t;
|
|
stack : Codegen.stack_context;
|
|
stack : Codegen.stack_context;
|
|
|
|
+ smap : sourcemap;
|
|
mutable current : tclass;
|
|
mutable current : tclass;
|
|
mutable statics : (tclass * string * texpr) list;
|
|
mutable statics : (tclass * string * texpr) list;
|
|
mutable inits : texpr list;
|
|
mutable inits : texpr list;
|
|
@@ -67,11 +85,120 @@ let field s = if Hashtbl.mem kwds s then "[\"" ^ s ^ "\"]" else "." ^ s
|
|
let ident s = if Hashtbl.mem kwds s then "$" ^ s else s
|
|
let ident s = if Hashtbl.mem kwds s then "$" ^ s else s
|
|
let anon_field s = if Hashtbl.mem kwds s || not (valid_js_ident s) then "'" ^ s ^ "'" else s
|
|
let anon_field s = if Hashtbl.mem kwds s || not (valid_js_ident s) then "'" ^ s ^ "'" else s
|
|
|
|
|
|
-let spr ctx s = ctx.separator <- false; Buffer.add_string ctx.buf s
|
|
|
|
-let print ctx = ctx.separator <- false; Printf.kprintf (fun s -> Buffer.add_string ctx.buf s)
|
|
|
|
|
|
+let handle_newlines ctx str =
|
|
|
|
+ if ctx.com.debug then
|
|
|
|
+ let rec loop from =
|
|
|
|
+ try begin
|
|
|
|
+ let next = String.index_from str from '\n' + 1 in
|
|
|
|
+ Buffer.add_char ctx.smap.mappings ';';
|
|
|
|
+ ctx.smap.output_last_col <- 0;
|
|
|
|
+ ctx.smap.print_comma <- false;
|
|
|
|
+ loop next
|
|
|
|
+ end with Not_found ->
|
|
|
|
+ ctx.smap.output_current_col <- String.length str - from
|
|
|
|
+ in
|
|
|
|
+ loop 0
|
|
|
|
+ else ()
|
|
|
|
+
|
|
|
|
+let spr ctx s =
|
|
|
|
+ ctx.separator <- false;
|
|
|
|
+ handle_newlines ctx s;
|
|
|
|
+ Buffer.add_string ctx.buf s
|
|
|
|
+
|
|
|
|
+let print ctx =
|
|
|
|
+ ctx.separator <- false;
|
|
|
|
+ Printf.kprintf (fun s -> begin
|
|
|
|
+ handle_newlines ctx s;
|
|
|
|
+ Buffer.add_string ctx.buf s
|
|
|
|
+ end)
|
|
|
|
|
|
let unsupported p = error "This expression cannot be compiled to Javascript" p
|
|
let unsupported p = error "This expression cannot be compiled to Javascript" p
|
|
|
|
|
|
|
|
+let add_mapping ctx pos =
|
|
|
|
+ let smap = ctx.smap in
|
|
|
|
+ let file = try
|
|
|
|
+ Hashtbl.find smap.sources_hash pos.pfile
|
|
|
|
+ with Not_found ->
|
|
|
|
+ let length = DynArray.length smap.sources in
|
|
|
|
+ Hashtbl.replace smap.sources_hash pos.pfile length;
|
|
|
|
+ DynArray.add smap.sources pos.pfile;
|
|
|
|
+ length
|
|
|
|
+ in
|
|
|
|
+ let line, col = Lexer.find_pos pos in
|
|
|
|
+ let line = line - 1 in
|
|
|
|
+ let col = col - 1 in
|
|
|
|
+ if smap.source_last_file != file || smap.source_last_line != line || smap.source_last_col != col then begin
|
|
|
|
+ if smap.print_comma then
|
|
|
|
+ Buffer.add_char smap.mappings ','
|
|
|
|
+ else
|
|
|
|
+ smap.print_comma <- true;
|
|
|
|
+
|
|
|
|
+ let base64_vlq number =
|
|
|
|
+ let encode_digit digit =
|
|
|
|
+ let chars = [|
|
|
|
|
+ 'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';
|
|
|
|
+ 'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f';
|
|
|
|
+ 'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v';
|
|
|
|
+ 'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/'
|
|
|
|
+ |] in
|
|
|
|
+ Array.unsafe_get chars digit
|
|
|
|
+ in
|
|
|
|
+ let to_vlq number =
|
|
|
|
+ if number < 0 then
|
|
|
|
+ ((-number) lsl 1) + 1
|
|
|
|
+ else
|
|
|
|
+ number lsl 1
|
|
|
|
+ in
|
|
|
|
+ let rec loop vlq =
|
|
|
|
+ let shift = 5 in
|
|
|
|
+ let base = 1 lsl shift in
|
|
|
|
+ let mask = base - 1 in
|
|
|
|
+ let continuation_bit = base in
|
|
|
|
+ let digit = vlq land mask in
|
|
|
|
+ let next = vlq asr shift in
|
|
|
|
+ Buffer.add_char smap.mappings (encode_digit (
|
|
|
|
+ if next > 0 then digit lor continuation_bit else digit));
|
|
|
|
+ if next > 0 then loop next else ()
|
|
|
|
+ in
|
|
|
|
+ loop (to_vlq number)
|
|
|
|
+ in
|
|
|
|
+
|
|
|
|
+ base64_vlq (smap.output_current_col - smap.output_last_col);
|
|
|
|
+ base64_vlq (file - smap.source_last_file);
|
|
|
|
+ base64_vlq (line - smap.source_last_line);
|
|
|
|
+ base64_vlq (col - smap.source_last_col);
|
|
|
|
+
|
|
|
|
+ smap.source_last_file <- file;
|
|
|
|
+ smap.source_last_line <- line;
|
|
|
|
+ smap.source_last_col <- col;
|
|
|
|
+ smap.output_last_col <- smap.output_current_col
|
|
|
|
+ end
|
|
|
|
+
|
|
|
|
+let basename path =
|
|
|
|
+ try
|
|
|
|
+ let idx = String.rindex path '/' in
|
|
|
|
+ String.sub path (idx + 1) (String.length path - idx - 1)
|
|
|
|
+ with Not_found -> path
|
|
|
|
+
|
|
|
|
+let write_mappings ctx =
|
|
|
|
+ let basefile = basename ctx.com.file in
|
|
|
|
+ print ctx "\n//@ sourceMappingURL=%s.map" basefile;
|
|
|
|
+ let channel = open_out_bin (ctx.com.file ^ ".map") in
|
|
|
|
+ let sources = DynArray.to_list ctx.smap.sources in
|
|
|
|
+ output_string channel "{\n";
|
|
|
|
+ output_string channel "\"version\":3,\n";
|
|
|
|
+ output_string channel ("\"file\":\"" ^ basefile ^ "\",\n");
|
|
|
|
+ output_string channel ("\"sourceRoot\":\"file://\",\n");
|
|
|
|
+ output_string channel ("\"sources\":[" ^
|
|
|
|
+ (String.concat "," (List.map (fun s -> "\"" ^ Common.get_full_path s ^ "\"") sources)) ^
|
|
|
|
+ "],\n");
|
|
|
|
+ output_string channel "\"names\":[],\n";
|
|
|
|
+ output_string channel "\"mappings\":\"";
|
|
|
|
+ Buffer.output_buffer channel ctx.smap.mappings;
|
|
|
|
+ output_string channel "\"\n";
|
|
|
|
+ output_string channel "}";
|
|
|
|
+ close_out channel
|
|
|
|
+
|
|
let newline ctx =
|
|
let newline ctx =
|
|
match Buffer.nth ctx.buf (Buffer.length ctx.buf - 1) with
|
|
match Buffer.nth ctx.buf (Buffer.length ctx.buf - 1) with
|
|
| '}' | '{' | ':' when not ctx.separator -> print ctx "\n%s" ctx.tabs
|
|
| '}' | '{' | ':' when not ctx.separator -> print ctx "\n%s" ctx.tabs
|
|
@@ -101,10 +228,7 @@ let fun_block ctx f p =
|
|
| None | Some TNull -> e
|
|
| None | Some TNull -> e
|
|
| Some c -> Codegen.concat (Codegen.set_default ctx.com a c p) e
|
|
| Some c -> Codegen.concat (Codegen.set_default ctx.com a c p) e
|
|
) f.tf_expr f.tf_args in
|
|
) f.tf_expr f.tf_args in
|
|
- if ctx.com.debug then
|
|
|
|
- Codegen.stack_block ctx.stack ctx.current (fst ctx.curmethod) e
|
|
|
|
- else
|
|
|
|
- e
|
|
|
|
|
|
+ e
|
|
|
|
|
|
let open_block ctx =
|
|
let open_block ctx =
|
|
let oldt = ctx.tabs in
|
|
let oldt = ctx.tabs in
|
|
@@ -533,6 +657,8 @@ and gen_block ctx e =
|
|
| _ -> newline ctx; gen_expr ctx e
|
|
| _ -> newline ctx; gen_expr ctx e
|
|
|
|
|
|
and gen_value ctx e =
|
|
and gen_value ctx e =
|
|
|
|
+ if ctx.com.debug && e.epos.pmin >= 0 then
|
|
|
|
+ add_mapping ctx e.epos;
|
|
let assign e =
|
|
let assign e =
|
|
mk (TBinop (Ast.OpAssign,
|
|
mk (TBinop (Ast.OpAssign,
|
|
mk (TLocal (match ctx.in_value with None -> assert false | Some v -> v)) t_dynamic e.epos,
|
|
mk (TLocal (match ctx.in_value with None -> assert false | Some v -> v)) t_dynamic e.epos,
|
|
@@ -816,6 +942,17 @@ let alloc_ctx com =
|
|
stack = Codegen.stack_init com false;
|
|
stack = Codegen.stack_init com false;
|
|
buf = Buffer.create 16000;
|
|
buf = Buffer.create 16000;
|
|
packages = Hashtbl.create 0;
|
|
packages = Hashtbl.create 0;
|
|
|
|
+ smap = {
|
|
|
|
+ source_last_line = 0;
|
|
|
|
+ source_last_col = 0;
|
|
|
|
+ source_last_file = 0;
|
|
|
|
+ print_comma = false;
|
|
|
|
+ output_last_col = 0;
|
|
|
|
+ output_current_col = 0;
|
|
|
|
+ sources = DynArray.create();
|
|
|
|
+ sources_hash = Hashtbl.create 0;
|
|
|
|
+ mappings = Buffer.create 16;
|
|
|
|
+ };
|
|
statics = [];
|
|
statics = [];
|
|
inits = [];
|
|
inits = [];
|
|
current = null_class;
|
|
current = null_class;
|
|
@@ -838,10 +975,6 @@ let gen_single_expr ctx e expr =
|
|
ctx.id_counter <- 0;
|
|
ctx.id_counter <- 0;
|
|
str
|
|
str
|
|
|
|
|
|
-let set_debug_infos ctx c m s =
|
|
|
|
- ctx.current <- c;
|
|
|
|
- ctx.curmethod <- (m,s)
|
|
|
|
-
|
|
|
|
let generate com =
|
|
let generate com =
|
|
let t = Common.timer "generate js" in
|
|
let t = Common.timer "generate js" in
|
|
(match com.js_gen with
|
|
(match com.js_gen with
|
|
@@ -874,6 +1007,7 @@ function $extend(from, fields) {
|
|
(match com.main with
|
|
(match com.main with
|
|
| None -> ()
|
|
| None -> ()
|
|
| Some e -> gen_expr ctx e);
|
|
| Some e -> gen_expr ctx e);
|
|
|
|
+ if com.debug then write_mappings ctx;
|
|
let ch = open_out_bin com.file in
|
|
let ch = open_out_bin com.file in
|
|
output_string ch (Buffer.contents ctx.buf);
|
|
output_string ch (Buffer.contents ctx.buf);
|
|
close_out ch);
|
|
close_out ch);
|