├── .hgignore
├── forbidden.properties
├── tests
    ├── test14.js
    ├── test7.js
    ├── test13.js
    ├── test3.js
    ├── test9.js
    ├── test12.js
    ├── test11.js
    ├── test5.js
    ├── test6.js
    ├── fail
    │   ├── fail1.js
    │   └── fail2.js
    ├── test1.js
    ├── test15.js
    ├── test.sh
    ├── test8.js
    ├── test4.js
    ├── test10.js
    └── test2.js
├── version.ml
├── ecma-262.pdf
├── _tags
├── pffpsf.ml
├── CHANGES
├── Makefile
├── AUTHORS
├── ansi.mli
├── fake_ansi.ml
├── test_ecma.ml
├── excerpt.ml
├── minefield.ml
├── conduit.ml
├── conduit.mli
├── cache.ml
├── ansi.ml
├── myocamlbuild.ml
├── qwerty.ml
├── README
├── opt.ml
├── misc
    └── options.rb
├── liner.ml
├── levenshtein.ml
├── ecmarex.peg
├── source.ml
├── ast.ml
├── manual.txt
├── ecmalexer.lex
├── LICENSE
├── generate.ml
├── jsure.ml
├── convert.ml
├── eval.ml
├── process.ml
├── check.ml
└── ecma.peg


/.hgignore:
--------------------------------------------------------------------------------
1 | _build
2 | 


--------------------------------------------------------------------------------
/forbidden.properties:
--------------------------------------------------------------------------------
1 | name
2 | toto
3 | 


--------------------------------------------------------------------------------
/tests/test14.js:
--------------------------------------------------------------------------------
1 | var toto = titi;
2 | 


--------------------------------------------------------------------------------
/version.ml:
--------------------------------------------------------------------------------
1 | let version = (1,0,4)
2 | 


--------------------------------------------------------------------------------
/ecma-262.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/berke/jsure/HEAD/ecma-262.pdf


--------------------------------------------------------------------------------
/tests/test7.js:
--------------------------------------------------------------------------------
1 | var foo = "toto";
2 | var bar = foo;
3 | var gogol = foo ++;
4 | 


--------------------------------------------------------------------------------
/tests/test13.js:
--------------------------------------------------------------------------------
1 | function bar(w, j) {
2 |   var x = a^b^c^d;
3 |   return x;
4 | }
5 | 


--------------------------------------------------------------------------------
/tests/test3.js:
--------------------------------------------------------------------------------
1 | return true;
2 | return a().f().z;
3 | var Abstract = new Object();
4 | 


--------------------------------------------------------------------------------
/tests/test9.js:
--------------------------------------------------------------------------------
1 | var f = 4;
2 | 
3 | function foo(a,b,c) {
4 |   var d;
5 |   d += c;
6 |   e ++;
7 |   f ++;
8 | }
9 | 


--------------------------------------------------------------------------------
/tests/test12.js:
--------------------------------------------------------------------------------
1 | function bar() {
2 |   var gogol = /si(:fu98e)r9[a-z0-9]/gi;
3 |   gogol.onmouseu = 55;
4 |   return gogol;
5 | }
6 | 


--------------------------------------------------------------------------------
/tests/test11.js:
--------------------------------------------------------------------------------
1 | function foo(a, b, unused, c_)
2 | {
3 |   var x, y, z;
4 |   x = 3;
5 |   y = 4;
6 |   z = a + b + c_;
7 |   c_ = 3;
8 | }
9 | 


--------------------------------------------------------------------------------
/tests/test5.js:
--------------------------------------------------------------------------------
1 | var x = true;
2 | var y = true;
3 | var a, b = true, c = false;
4 | if(true) return false else return true
5 | d = false;
6 | 


--------------------------------------------------------------------------------
/_tags:
--------------------------------------------------------------------------------
1 | <*.{ml,mli,byte,native,cma}>: use_aurochs_lib, use_libaurochs, use_unix, use_pack_lib, use_dbm, use_str, debug
2 | "jsure.ml": pp(camlp4o)
3 | 


--------------------------------------------------------------------------------
/pffpsf.ml:
--------------------------------------------------------------------------------
1 | (* Pffpsf *)
2 | 
3 | let pf = Printf.printf;;
4 | let fp = Printf.fprintf;;
5 | let sf = Printf.sprintf;;
6 | let bf = Printf.bprintf;;
7 | 


--------------------------------------------------------------------------------
/tests/test6.js:
--------------------------------------------------------------------------------
1 | function foo(a) {
2 |   //a.name = true;
3 |   //a[name] = true;
4 |   //a["name"] = true;
5 |   a = b.name;
6 |   a = b["name"];
7 | }
8 | 


--------------------------------------------------------------------------------
/tests/fail/fail1.js:
--------------------------------------------------------------------------------
 1 | /* Dangling comma */
 2 | 
 3 | var foo = {
 4 |   bar: 33,
 5 |   baz: {
 6 |     gogol: true,
 7 |     zorgol: false
 8 |   },
 9 | }
10 | 


--------------------------------------------------------------------------------
/tests/test1.js:
--------------------------------------------------------------------------------
 1 | return true;
 2 | function foo(x,y,z) {
 3 |   x.name = "foo";
 4 |   if(x) {
 5 |     return true
 6 |   } else {
 7 |     return x.y.z(a,b);
 8 |   }
 9 | }
10 | function f(x) { return 2 * 1 + 1 }
11 | 


--------------------------------------------------------------------------------
/CHANGES:
--------------------------------------------------------------------------------
1 | 2011-04-08 1.0.4 Implement -no-color option.
2 | 2009-01-16 1.0.3 Fixed parser bug involving hex constants and float lexemes (again!).
3 | 2008-03-11 1.0.2 Fixed parser bug involving unsigned right shift and float lexemes.
4 | 2008-03-10 1.0.1 Fixed parser bug involving do ... while(...) statements.
5 | 2008-01-13 1.0.0 First public version
6 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | # Makefile
 2 | 
 3 | .PHONY: all clean install tests jsure
 4 | 
 5 | PREFIX?=/usr/local
 6 | 
 7 | all: jsure
 8 | 
 9 | jsure:
10 | 	ocamlbuild jsure.native
11 | 
12 | install: all
13 | 	install -m 0755 jsure.native $(PREFIX)/bin/jsure
14 | 
15 | clean:
16 | 	rm -rf _build _log jsure.native
17 | 
18 | tests: jsure
19 | 	@cd tests; ./test.sh
20 | 


--------------------------------------------------------------------------------
/AUTHORS:
--------------------------------------------------------------------------------
 1 | Copyright
 2 | =========
 3 | This software is copyright (C)2007 Exalead SA.  It is released under the GNU Lesser General Public License (see LICENSE).
 4 | 
 5 | Author
 6 | ======
 7 | - Berke Durak, Ph.D., Exalead SA R&D Engineer
 8 |   berke.durak@exalead.com
 9 | 
10 | Grammar derived from a Yacc implementation by Jean-Baptiste Tristan
11 | of the ECMA grammar.
12 | 


--------------------------------------------------------------------------------
/ansi.mli:
--------------------------------------------------------------------------------
 1 | (* Ansi *)
 2 | 
 3 | val control : bool -> unit
 4 | 
 5 | val black : int
 6 | val red : int
 7 | val green : int
 8 | val yellow : int
 9 | val blue : int
10 | val magenta : int
11 | val cyan : int
12 | val white : int
13 | val uncoloured : int
14 | 
15 | val foreground : int -> string
16 | val background : int -> string
17 | val move_to : out_channel -> int -> unit
18 | val none : unit -> string
19 | 


--------------------------------------------------------------------------------
/tests/test15.js:
--------------------------------------------------------------------------------
 1 | // Sent by Michael Dayah
 2 | 
 3 | var numbers = [1e3, 2e-3];
 4 | var numbers2 = [1E-12];
 5 | foo = 0xff;
 6 | bar = 0xFF;
 7 | result = start + ((( Math.round(((((end & 0xFF0000) >> 16) - ((start    
 8 | & 0xFF0000) >> 16)) * n))) << 16) + (( Math.round(((((end & 0x00FF00) >> 8)     
 9 | - ((start & 0x00FF00) >> 8)) * n))) << 8) + (( Math.round((((end & 0x0000FF)    
10 | - (start & 0x0000FF)) * n)))));
11 | 


--------------------------------------------------------------------------------
/tests/test.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/zsh
 2 | 
 3 | JSURE=(../jsure.native -quiet)
 4 | 
 5 | jsure() {
 6 |   $JSURE >/dev/null 2>&1 $1
 7 | }
 8 | 
 9 | fail=0
10 | tests=0
11 | 
12 | for x in *.js ; do
13 |   tests=$((tests + 1))
14 |     ( jsure $x ) || ( fail=$((fail + 1)) ; echo "FAIL POSITIVE $x" )
15 | done
16 | 
17 | for x in fail/*.js ; do
18 |   tests=$((tests + 1))
19 |     ( jsure $x ) && ( fail=$((fail + 1)) ; echo "FAIL NEGATIVE $x" )
20 | done
21 | 
22 | echo "TESTS : " $tests
23 | echo "PASS  : " $((tests-fail))
24 | echo "FAIL  : " $fail
25 | 
26 | if [ $fail -lt 0 ]; then
27 |   exit 1
28 | else
29 |   exit 0
30 | fi
31 | 


--------------------------------------------------------------------------------
/fake_ansi.ml:
--------------------------------------------------------------------------------
 1 | let black      = 0;;
 2 | let red        = 1;;
 3 | let green      = 2;;
 4 | let yellow     = 3;;
 5 | let blue       = 4;;
 6 | let magenta    = 5;;
 7 | let cyan       = 6;;
 8 | let white      = 7;;
 9 | let uncoloured = 8;;
10 | 
11 | let foreground = [|
12 |   "";
13 |   "";
14 |   "";
15 |   "";
16 |   "";
17 |   "";
18 |   "";
19 |   "";
20 |   "";
21 | |];;
22 | 
23 | let background = [|
24 |   "";
25 |   "";
26 |   "";
27 |   "";
28 |   "";
29 |   "";
30 |   "";
31 |   "";
32 |   "";
33 | |];;
34 | 
35 | let move_to oc x = ()
36 | let up = ""
37 | let ceol = ""
38 | let home = ""
39 | let none = ""
40 | ;;
41 | 


--------------------------------------------------------------------------------
/tests/test8.js:
--------------------------------------------------------------------------------
 1 | gogol = 3;
 2 | 
 3 | function foo() {
 4 |   a = 3;
 5 |   var a = 3;
 6 |   a = 4;
 7 |   this.a;
 8 |   return a;
 9 | }
10 | 
11 | function
12 | foobar(a,b,c,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d) {
13 |   if(a) {
14 |     if(b) {
15 |       c = d;
16 |       b += a;
17 |     } else {
18 |       if(c) a += b;
19 |       if(d) { a += b; c += d; c += c }
20 |     }
21 |   }
22 |   a(b,c);
23 | }
24 | 
25 | function bar(z) {
26 |   z = 3;
27 | }
28 | 
29 | function barbar(z) {
30 |   var z = 3;
31 | }
32 | 
33 | var x;
34 | 
35 | gogol() {
36 |   x = foo;
37 | }
38 | 


--------------------------------------------------------------------------------
/test_ecma.ml:
--------------------------------------------------------------------------------
 1 | module M = Ecma_parser;;
 2 | 
 3 | let read_file fn =
 4 |   let ic = open_in fn in
 5 |   let m = in_channel_length ic in
 6 |   let u = String.create m in
 7 |   really_input ic u 0 m;
 8 |   close_in ic;
 9 |   u
10 | ;;
11 | 
12 | let _ =
13 |   let fn = Sys.argv.(1) in
14 |   let u = read_file fn in
15 |   let t = M.parse u in
16 |   M.print_tree stdout t
17 | ;;
18 | 
19 | let parsing_prefixes u =
20 |   let m = String.length u in
21 |   for i = 1 to m - 1 do
22 |     let v = String.sub u 0 i in
23 |     try
24 |       let _t = M.parse v in
25 |       Printf.printf ">> %d\n%!" i
26 |     with
27 |     | _ -> ()
28 |   done
29 | ;;
30 | 


--------------------------------------------------------------------------------
/tests/test4.js:
--------------------------------------------------------------------------------
 1 | var a = 1, b = 2;
 2 | for(var i = 0, length = arguments.length; i < 33; i ++) {
 3 |   print(i);
 4 | }
 5 | 
 6 | var toto = {
 7 |   onTimerEvent: function() {
 8 |     /*if (!this.currentlyExecuting)*/ {
 9 |     }
10 |   }
11 | }
12 | 
13 | var gogol = /[a-z]/;
14 | 
15 | var foo = ' ';
16 | 
17 | var foo = '';
18 | 
19 | var foo = [1, 2];
20 | 
21 | function foo() {
22 |   switch(a) {
23 |     case 3: return true;
24 |   }
25 |     for(var i = 0, length = arguments.length; i < length; i++) {
26 |       var value = this[arguments[i]];
27 |       return 1.0;
28 |       if (x) {
29 |         return true;
30 |       } else { }
31 |       delete this[arguments[i]];
32 |     }
33 | }
34 | 


--------------------------------------------------------------------------------
/excerpt.ml:
--------------------------------------------------------------------------------
 1 | (* Excerpt *)
 2 | 
 3 | open Pffpsf
 4 | 
 5 | (*** excerpt *)
 6 | let excerpt liner text start_pos end_pos =
 7 |   let lines = Source.extract_lines liner text start_pos end_pos in
 8 |   let b = Buffer.create 256 in
 9 |   Array.iter
10 |     begin fun (l, u, v, w) ->
11 |       if Buffer.length b > 0 then bf b "\n";
12 |       bf b "%s%5d%s %s%s%s%s%s%s%s"
13 |            (Ansi.foreground !Opt.line_number_color) (l + 1) (Ansi.none ())
14 |            (Ansi.foreground !Opt.code_color) u
15 |            (Ansi.foreground !Opt.code_hl_color) v
16 |            (Ansi.foreground !Opt.code_color) w
17 |            (Ansi.none ())
18 |     end
19 |     lines;
20 |   Buffer.contents b
21 | (* ***)
22 | 


--------------------------------------------------------------------------------
/tests/fail/fail2.js:
--------------------------------------------------------------------------------
 1 | var a = 1, b = 2;
 2 | for(var i = 0, length = arguments.length; i <  ; i ++) {
 3 |   print(i);
 4 | }
 5 | 
 6 | var toto = {
 7 |   onTimerEvent: function() {
 8 |     /*if (!this.currentlyExecuting)*/ {
 9 |     }
10 |   }
11 | }
12 | 
13 | var gogol = /[a-z]/;
14 | 
15 | var foo = ' ';
16 | 
17 | var foo = '';
18 | 
19 | var foo = [1, 2];
20 | 
21 | function foo() {
22 |   switch(a) {
23 |     case 3: return true;
24 |   }
25 |     for(var i = 0, length = arguments.length; i < length; i++) {
26 |       var value = this[arguments[i]];
27 |       return 1.0;
28 |       if (x) {
29 |         return true;
30 |       } else { }
31 |       delete this[arguments[i]];
32 |     }
33 | }
34 | 


--------------------------------------------------------------------------------
/tests/test10.js:
--------------------------------------------------------------------------------
 1 | function toto(b) {
 2 |   with(this) {
 3 |     var options = select.getElementsByTagName("option");
 4 |     assertEqual("choice1", options[0].value);
 5 |     assertEqual("other", options[1].value);
 6 |     assert( options[1].selected, "second option is selected"); 
 7 |     assertEqual("other", select.getValue());
 8 | 
 9 |     select.addOption("choice3", "third", true);
10 |     assert( options[1].selected, "second option is still selected (multiple=true)"); 
11 |     assert( options[2].selected, "third option is also selected"); 
12 |     var options = select.getElementsByTagName("option");
13 |     if(x) {
14 |       return false;
15 |     } else {
16 |       return false;
17 |     }
18 |     return foo;
19 |   }
20 | }
21 | 
22 | 


--------------------------------------------------------------------------------
/minefield.ml:
--------------------------------------------------------------------------------
 1 | (* Minefield *)
 2 | 
 3 | module SS = Set.Make(String);;
 4 | module SM = Map.Make(String);;
 5 | 
 6 | type t = {
 7 |   mutable mf_words : int SM.t;
 8 | }
 9 | 
10 | module L = Levenshtein.Levenshtein_string;;
11 | 
12 | let create () = { mf_words = SM.empty };;
13 | 
14 | let add_word mf u = mf.mf_words <- SM.add u 0 mf.mf_words;;
15 | 
16 | let check_proximity mf u =
17 |   if SM.mem u mf.mf_words then
18 |     None
19 |   else
20 |     begin
21 |       let min_dist = ref max_float in
22 |       let nearest_word = ref None in
23 |       SM.iter
24 |         begin fun v _ ->
25 |           let d = L.distance u v in
26 |           if d < !min_dist then
27 |             begin
28 |               min_dist := d;
29 |               nearest_word := Some v
30 |             end
31 |         end
32 |         mf.mf_words;
33 |       match !nearest_word with
34 |       | None -> None
35 |       | Some v -> Some(!min_dist, v)
36 |     end
37 | ;;
38 | 


--------------------------------------------------------------------------------
/conduit.ml:
--------------------------------------------------------------------------------
 1 | (* Conduit *)
 2 | 
 3 | type 'channel conduit = {
 4 |   cd_out_channel : 'channel; 
 5 |   cd_print       : 'a . 'channel -> ('a, 'channel, unit) format -> 'a; 
 6 |   cd_flush       : 'channel -> unit; 
 7 | };;
 8 | 
 9 | let stdoutcd = {
10 |   cd_out_channel = stdout;
11 |   cd_print = Printf.fprintf;
12 |   cd_flush = flush
13 | };;
14 | 
15 | let stderrcd = {
16 |   cd_out_channel = stderr;
17 |   cd_print = Printf.fprintf;
18 |   cd_flush = flush
19 | };;
20 | 
21 | let conduit_of_channel oc = {
22 |   cd_out_channel = oc;
23 |   cd_print = Printf.fprintf;
24 |   cd_flush = flush
25 | };;
26 | 
27 | let conduit_of_buffer b =
28 |   { cd_out_channel = b;
29 |     cd_print = Printf.bprintf;
30 |     cd_flush = ignore }
31 | ;;
32 | 
33 | let scribe_string cd oc u = cd.cd_print oc "%s" u;;
34 | 
35 | (*** stringify *)
36 | let stringify f =
37 |   let b = Buffer.create 128 in
38 |   let cd = conduit_of_buffer b in
39 |   f cd cd.cd_out_channel;
40 |   Buffer.contents b
41 | ;;
42 | (* ***)
43 | 


--------------------------------------------------------------------------------
/conduit.mli:
--------------------------------------------------------------------------------
 1 | (* Conduit *)
 2 | (* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt and The EDOS Project. *)
 3 | (* Released under the GNU LGPL version 2. *)
 4 | 
 5 | (** A conduit is a channel for using formatting functions on buffers or channels. *)
 6 | type 'a conduit = {
 7 |   cd_out_channel : 'a;                              (** Can be a buffer or a channel. *)
 8 |   cd_print : 'b. 'a -> ('b, 'a, unit) format -> 'b; (** The print function. *)
 9 |   cd_flush : 'a -> unit;                            (** The flush function. *)
10 | }
11 | 
12 | val stdoutcd : out_channel conduit (** The conduit linked to standard output *)
13 | 
14 | val stderrcd : out_channel conduit (** The conduit linked to standard error *)
15 | 
16 | val conduit_of_channel : out_channel -> out_channel conduit (** Builds a conduit from an output channel. *)
17 | 
18 | val conduit_of_buffer : Buffer.t -> Buffer.t conduit (** Builds a conduit from a buffer. *)
19 | 
20 | val scribe_string : 'a conduit -> 'a -> string -> unit (** Writes a string into a conduit. *)
21 | 
22 | val stringify : (Buffer.t conduit -> Buffer.t -> unit) -> string
23 | 


--------------------------------------------------------------------------------
/cache.ml:
--------------------------------------------------------------------------------
 1 | (* Cache *)
 2 | 
 3 | type t = {
 4 |   c_db : Dbm.t;
 5 |   c_version : string
 6 | };;
 7 | 
 8 | let create ?(version=0) fn =
 9 |   let db = Dbm.opendbm fn [Dbm.Dbm_rdwr; Dbm.Dbm_create] 0o644 in
10 |   let s = Printf.sprintf "%d;" version in
11 |   { c_db = db;
12 |     c_version = s }
13 | ;;
14 | 
15 | let digest_length = 16;;
16 | 
17 | (*** get *)
18 | let get c name u =
19 |   let data = Dbm.find c.c_db name in
20 |   let digest = Digest.string u in
21 |   let version = String.sub data 0 (String.length c.c_version) in
22 |   if version <> c.c_version then raise Not_found;
23 |   let digest' = String.sub data (String.length c.c_version) digest_length in
24 |   if digest = digest' then
25 |     Marshal.from_string data (String.length c.c_version + digest_length)
26 |   else
27 |     raise Not_found
28 | ;;
29 | (* ***)
30 | (*** set *)
31 | let set c name u x =
32 |   let digest = Digest.string u in
33 |   let data = Marshal.to_string x [] in
34 |   Dbm.replace c.c_db name (c.c_version ^ digest ^ data)
35 | ;;
36 | (* ***)
37 | (*** close *)
38 | let close c =
39 |   Dbm.close c.c_db
40 | ;;
41 | (* ***)
42 | 


--------------------------------------------------------------------------------
/ansi.ml:
--------------------------------------------------------------------------------
 1 | (* Ansi *)
 2 | 
 3 | open Pffpsf;;
 4 | 
 5 | let enabled    = ref true;;
 6 | 
 7 | let control x = enabled := x
 8 | 
 9 | let filter u = if !enabled then u else "";;
10 | 
11 | let black      = 0;;
12 | let red        = 1;;
13 | let green      = 2;;
14 | let yellow     = 3;;
15 | let blue       = 4;;
16 | let magenta    = 5;;
17 | let cyan       = 6;;
18 | let white      = 7;;
19 | let uncoloured = 8;;
20 | 
21 | let foreground_array = [|
22 |   "\027[30m";
23 |   "\027[31m";
24 |   "\027[32m";
25 |   "\027[33m";
26 |   "\027[34m";
27 |   "\027[35m";
28 |   "\027[36m";
29 |   "\027[37m";
30 |   "\027[0m";
31 | |];;
32 | 
33 | let foreground i = filter foreground_array.(i);;
34 | 
35 | let background_array = [|
36 |   "\027[40m";
37 |   "\027[41m";
38 |   "\027[42m";
39 |   "\027[43m";
40 |   "\027[44m";
41 |   "\027[45m";
42 |   "\027[46m";
43 |   "\027[47m";
44 |   "\027[0m";
45 | |];;
46 | 
47 | let background i = filter background_array.(i);;
48 | 
49 | let move_to oc x = if !enabled then fp oc "\r\027[%dC\027[K" x else ();;
50 | let up () = filter "\027[1A"
51 | let ceol () = filter "\027[K"
52 | let home () = filter "\r"
53 | let none () = filter "\027[0m"
54 | ;;
55 | 


--------------------------------------------------------------------------------
/myocamlbuild.ml:
--------------------------------------------------------------------------------
 1 | (* Myocamlbuild for Jsure *)
 2 | 
 3 | open Ocamlbuild_pack;;
 4 | open Ocamlbuild_plugin;;
 5 | open Command;;
 6 | open Ocaml_specific;;
 7 | 
 8 | let aurochs = ref (S[A"aurochs";A"-quiet";A"-target";A"ml"]);;
 9 | let system_lib_dir = "/usr/lib";;
10 | 
11 | dispatch
12 |   begin function
13 |   | After_rules ->
14 |       begin
15 |         List.iter
16 |           begin fun lib ->
17 |             flag ["ocaml"; "link"]    (S[A"-I"; A("+"^lib)]);
18 |             flag ["ocaml"; "compile"] (S[A"-I"; A("+"^lib)]);
19 |           end
20 |           ["aurochs_lib"];
21 | 
22 |         Options.ocamlopt := S[A"ocamlopt";A"-verbose"];
23 | 
24 |         ocaml_lib ~extern:true "aurochs_lib";
25 | 
26 |         flag ["link"; "ocaml"; "byte"; "use_libaurochs"]
27 |              (S[A"-dllib";A("-laurochs"); A"-cclib";A("-laurochs")]);
28 | 
29 |         flag ["link"; "ocaml"; "use_libaurochs"]
30 |              (S[A"-ccopt"; A("-L"^system_lib_dir); A"-cclib"; A"-laurochs"]);
31 | 
32 |         rule "aurochs: .peg -> .ml,.mli"
33 | 
34 |         ~prods:["%.ml";"%.mli"]
35 | 
36 |         ~dep:"%.peg"
37 |           begin fun env _build ->
38 |             let peg = env "%.peg" and ml = env "%.ml" in
39 |             let tags = tags_of_pathname ml++"aurochs" in
40 |             Cmd(S[!aurochs; T tags; P peg])
41 |           end
42 |       end
43 |   | _ -> ()
44 |   end
45 | 


--------------------------------------------------------------------------------
/qwerty.ml:
--------------------------------------------------------------------------------
 1 | (* Qwerty *)
 2 | (* Written by Berke DURAK, released in the public Domain. *)
 3 | 
 4 | let row y0 x0 w u1 u2 =
 5 |   let m = String.length u1 in
 6 |   let r = ref [] in
 7 |   let _shift_distance = 10.0 in
 8 |   for i = 0 to m - 1 do
 9 |     r := (y0, x0 +. (float_of_int i) *. w, 0.0, u1.[i])::!r;
10 |     r := (y0, x0 +. (float_of_int i) *. w, 10.0, u2.[i])::!r
11 |   done;
12 |   !r
13 | ;;
14 | 
15 | let qwerty_description = List.concat [
16 |   row 0.0 0.0 1.7461
17 |     "`1234567890-="
18 |     "~!@#$%^&*()_+";
19 |   [1.5,1.0,0.0,'\t'];
20 |   row 1.5 2.8 1.7461 "qwertyuiop[]" "QWERTYUIOP{}";
21 |   row 3.0 3.4 1.7461 "asdfghjkl;'\\" "ASDFGHJKL:\"|";
22 |   row 4.5 2.8 1.7461 "<zxcvbnm,./" ">ZXCVBNM<>?";
23 |   [6.0,12.5,0.0,' ']
24 | ];;
25 | 
26 | let qwerty_dummy = (20.0,4.0,0.5);;
27 | 
28 | let qwerty_map =
29 |   let a = Array.make 256 qwerty_dummy in
30 |   List.iter (fun (x,y,z,c) -> a.(Char.code c) <- (x,y,z)) qwerty_description;
31 |   a
32 | ;;
33 | 
34 | let euclidian_distance (x1,y1,z1) (x2,y2,z2) =
35 |   let f a1 a2 = (a1 -. a2) *. (a1 -. a2) in
36 |   sqrt ((f x1 x2) +. (f y1 y2) +. (f z1 z2))
37 | ;;
38 | 
39 | let qwerty_insertion_cost = 4.0
40 | let qwerty_deletion_cost = qwerty_insertion_cost
41 | ;;
42 | 
43 | let qwerty_distance c1 c2 =
44 |   let p c = qwerty_map.(Char.code c) in
45 |   match (c1,c2) with
46 |     None,None -> 0.0
47 |   | Some(_),None -> qwerty_deletion_cost
48 |   | None,Some(_) -> qwerty_insertion_cost
49 |   | Some(c1),Some(c2) ->
50 |       euclidian_distance (p c1) (p c2)
51 | ;;
52 | 


--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
 1 | Installation instructions
 2 | =========================
 3 | 
 4 | * Pre-compiled binaries for Linux are available in bin/
 5 | * To compile Jsure:
 6 |   - Get, build and install Aurochs from http://aurochs.fr/
 7 |   - make
 8 |   - PREFIX=/usr/local make install
 9 | 
10 | Important note
11 | ==============
12 | I have recently discovered that the Javascript grammar allows you to omit
13 | semicolons in most circumstances.  Actually, it is more on the order
14 | of tolerating forgotten semicolons than "allowing" their omission, because the
15 | parser described in the ECMA specification is supposed to backtrack and retry
16 | when it doesn't find an expected semicolon.  Of course this (1) supposes
17 | a particular parsing method and (2) makes the suggested parser run slowly.
18 | 
19 | Unfortunately I would need to completely rewrite my Javascript grammar
20 | (and possibly make hacks to Aurochs) to support the omission of semicolons.
21 | 
22 | I think omitting semicolons is very bad practice.  For one thing, it
23 | makes the source more ambiguous and harder to read.  For another thing,
24 | it departs from common C and Java syntactic conventions.  Fortunately,
25 | it seems that only a handful of people systematically omit semicolons.
26 | 
27 | I'm saying a handful but I have only seen one such case:  someone whose
28 | Javascript looked like
29 | 
30 |   function GetLen_(G) { var K, L, C = ""	// Get good margin
31 |     G.Len.value = K = L = Math.max(G.Len.value, 1)
32 |     while (--K) C += " " ; G.Result.value = C + "|"
33 |     return L }
34 | 
35 | I guess people who'll use Jsure are not in the business of obfuscating
36 | their source (there are tools for that), so I'll leave semicolons mandatory.
37 | 


--------------------------------------------------------------------------------
/opt.ml:
--------------------------------------------------------------------------------
 1 | (* Opt *)
 2 | 
 3 | open Source;;
 4 | 
 5 | let dump_ast = ref false;;
 6 | let dump_raw_ast = ref false;;
 7 | let dump_env = ref false;;
 8 | let just_syntax = ref false;;
 9 | let dont_catch = ref false;;
10 | let list_props = ref false;;
11 | let quiet = ref false;;
12 | let no_warnings = ref false;;
13 | let warnify : string list ref = ref [];;
14 | let ignorify : string list ref = ref [];;
15 | let minefield : string option ref = ref None;;
16 | let forbidden_props_file : string option ref = ref None;;
17 | let check = ref true;;
18 | let typecheck = ref false;;
19 | let mine_distance = ref 5.0;;
20 | let unused_ident_regexp = ref "^_.*_$";;
21 | let safe_property_regexp = ref "[a-zA-Z_][a-zA-Z0-9_]*";;
22 | let filename_regexp = ref ".*\\.js";;
23 | let generate = ref false;;
24 | let read_from_stdin = ref false;;
25 | let line_number_offset = ref 0;;
26 | 
27 | let undefined_variables  = ref Ign;;
28 | let unbound_variables    = ref Wrn;;
29 | let toplevel_bindings    = ref Ign;;
30 | let assigning_to_args    = ref Ign;;
31 | let unused_vars          = ref Wrn;;
32 | let unused_funs          = ref Wrn;;
33 | let unused_args          = ref Wrn;;
34 | let using_unused         = ref Wrn;;
35 | let uninitialized_vars   = ref Wrn;;
36 | let shadowing_args       = ref Wrn;;
37 | let unreachable_code     = ref Wrn;;
38 | let dangling_commas      = ref Err;;
39 | let bad_regexps          = ref Err;;
40 | 
41 | let error_visualization   = ref Txt;;
42 | let warning_visualization = ref Txt;;
43 | 
44 | let info_color        = ref Ansi.green;;
45 | let warning_color     = ref Ansi.yellow;;
46 | let error_color       = ref Ansi.red;;
47 | let line_number_color = ref Ansi.blue;;
48 | let code_color        = ref Ansi.uncoloured;;
49 | let code_hl_color     = ref Ansi.red;;
50 | 
51 | let cache : string option ref = ref None;;
52 | 


--------------------------------------------------------------------------------
/misc/options.rb:
--------------------------------------------------------------------------------
 1 | def allowed_options {
 2 |  :just_syntax          => {:type => 'bool', :default => false,  :description => 'Just check the syntax of input files'},
 3 |  :no_warnings          => {:type => 'bool', :default => false,  :description => 'Suppress warnings'},
 4 |  :no_check             => {:type => 'bool', :default => false,  :description => 'Disable basic semantic checks'},
 5 |  :assigning_to_args    => {:type => 'wei',  :default => 'i',    :description => 'Assigning to arguments'},
 6 |  :bad_regexps          => {:type => 'wei',  :default => 'e',    :description => 'Bad regular expression litterals'}
 7 |  :dangling_commas      => {:type => 'wei',  :default => 'e',    :description => 'Dangling commas in object and array litterals'},
 8 |  :shadowing_args       => {:type => 'wei',  :default => 'w',    :description => 'Arguments shadowed by variables'},
 9 |  :toplevel_bindings    => {:type => 'wei',  :default => 'i',    :description => 'Setting global properties (without a "var")'},
10 |  :unbound_variables    => {:type => 'wei',  :default => 'w',    :description => 'Assigning to apparently unbound global variables, except in the toplevel'},
11 |  :undefined_variables  => {:type => 'wei',  :default => 'i',    :description => 'Referring to global names not obviously declared'},
12 |  :uninitialized_vars   => {:type => 'wei',  :default => 'w',    :description => 'Uninitialized variables'},
13 |  :unreachable_code     => {:type => 'wei',  :default => 'w',    :description => 'Unreachable code'},
14 |  :unused_args          => {:type => 'wei',  :default => 'w',    :description => 'Unused arguments'},
15 |  :unused_funs          => {:type => 'wei',  :default => 'w',    :description => 'Unused functions'},
16 |  :unused_vars          => {:type => 'wei',  :default => 'w',    :description => 'Unused variables'},
17 |  :using_unused         => {:type => 'wei',  :default => 'w',    :description => 'Using variables or arguments lexically declared to be unused'},
18 | 
19 |  # typecheck is too beta
20 |  #:typecheck            => {:type => 'bool', :default => true,   :description => 'Attempt to typecheck source files'},
21 | }
22 | 


--------------------------------------------------------------------------------
/tests/test2.js:
--------------------------------------------------------------------------------
 1 | var x = 3;
 2 | var x = { foo: bar, zonk: 33, foobar: true, toto: "shit", otot: 'shit' };
 3 | var gogol = {
 4 |   fun: {
 5 |     bar: baz,
 6 |     zonk: zink[33],
 7 |     fifi: function () { return false; },
 8 |     toutou: !!toutou
 9 |   }
10 | }
11 | function foo() {
12 |   return true;
13 | }
14 | function bar() {
15 | }
16 | var Prototype = {
17 |   Version: '1.5.0',
18 |   BrowserFeatures: {
19 |     XPath: !!document.evaluate
20 |   },
21 | 
22 |   ScriptFragment: '(?:<script.*?>)((\n|\r|.)*?)(?:<\/script>)',
23 |   emptyFunction: function() {},
24 |   K: function(x) { return x }
25 | }
26 | 
27 | var Class = {
28 |   create: function() {
29 |     return function() {
30 |       this.initialize.apply(this, arguments);
31 |     }
32 |   }
33 | }
34 | 
35 | var Abstract = new Object(3,4);
36 | 
37 | Object.extend = function(destination, source) {
38 |   for (var property in source) {
39 |     destination[property] = source[property];
40 |   }
41 |   return destination;
42 | }
43 | 
44 | Object.extend(Object, {
45 |   inspect: function(object) {
46 |     try {
47 |       if (object === undefined) return 'undefined';
48 |       if (object === null) return 'null';
49 |       return object.inspect ? object.inspect() : object.toString();
50 |     } catch (e) {
51 |       if (e instanceof RangeError) return '...';
52 |       throw e;
53 |     }
54 |   },
55 | 
56 |   keys: function(object) {
57 |     var keys = [];
58 |     for (var property in object)
59 |       keys.push(property);
60 |     return keys;
61 |   },
62 | 
63 |   values: function(object) {
64 |     var values = [];
65 |     for (var property in object)
66 |       values.push(object[property]);
67 |     return values;
68 |   },
69 | 
70 |   clone: function(object) {
71 |     return Object.extend({}, object);
72 |   }
73 | });
74 | 
75 | Function.prototype.bind = function() {
76 |   var __method = this, args = $A(arguments), object = args.shift();
77 |   return function() {
78 |     return __method.apply(object, args.concat($A(arguments)));
79 |   }
80 | }
81 | 
82 | Function.prototype.bindAsEventListener = function(object) {
83 |   return f(a).f(b);
84 | }
85 | 


--------------------------------------------------------------------------------
/liner.ml:
--------------------------------------------------------------------------------
 1 | (* Liner *)
 2 | 
 3 | (*** t *)
 4 | type t = {
 5 |   l_length : int;
 6 |   l_table : (int * int) array;
 7 |   l_offset : int
 8 | }
 9 | (* ***)
10 | (*** length *)
11 | let length l = l.l_length
12 | (* ***)
13 | (*** create *)
14 | let create ?(offset=0) u =
15 |   let m = String.length u in
16 |   let t = ref [] in
17 |   let line = ref 0 in
18 |   for i = 0 to m do
19 |     if i < m && u.[i] = '\n' or i = m then
20 |       begin
21 |         t := (!line, i) :: !t;
22 |         incr line
23 |       end
24 |   done;
25 |   { l_length = m;
26 |     l_table  = Array.of_list (List.rev !t);
27 |     l_offset = offset }
28 | (* ***)
29 | (*** line_to_range *)
30 | let line_to_range l ?(offset=l.l_offset) i =
31 |   let i = i - offset in
32 |   let (_, end_pos) = l.l_table.(i) in
33 |   if i = 0 then
34 |     (0, end_pos)
35 |   else
36 |     let (_, start_pos) = l.l_table.(i - 1) in
37 |     (start_pos + 1, end_pos)
38 | (* ***)
39 | (*** position_to_line *)
40 | let position_to_line l j =
41 |   let m = Array.length l.l_table in
42 |   let in_line i =
43 |     let (start_pos, end_pos) = line_to_range l ~offset:0 i in
44 |     start_pos <= j && j <= end_pos
45 |   in
46 |   let rec loop i0 m =
47 |     if m = 0 then
48 |       raise Not_found
49 |     else
50 |       begin
51 |         if m < 8 then
52 |           if in_line i0 then
53 |             i0
54 |           else
55 |             loop (i0 + 1) (m - 1)
56 |         else
57 |           let i = i0 + m / 2 in
58 |           let (start_pos, end_pos) = line_to_range l ~offset:0 i in
59 |           if start_pos <= j && j <= end_pos then
60 |             i
61 |           else
62 |             if j < start_pos then
63 |               loop i0 (m / 2)
64 |             else
65 |               loop (i + 1) (m - m / 2 - 1)
66 |       end
67 |   in
68 |   l.l_offset + loop 0 m
69 | (* ***)
70 | (*** test *)
71 | let test () =
72 |   let u = "alpha\nbeta\ngamma delta\nepsilon\n\nphi\n" in
73 |   let l = create u in
74 |   for i = 0 to String.length u - 1 do
75 |     let j = position_to_line l i in
76 |     let (s,e) = line_to_range l j in
77 |     Printf.printf "%d -> #%d [%d,%d]\n%!" i j s e
78 |   done
79 | (* ***)
80 | 


--------------------------------------------------------------------------------
/levenshtein.ml:
--------------------------------------------------------------------------------
 1 | (* Levenshtein *)
 2 | (* Written by Berke DURAK, released in the public Domain. *)
 3 | 
 4 | module type COSTS =
 5 |   sig
 6 |     type t
 7 |     val min : t -> t -> t
 8 |     val sum : t -> t -> t
 9 |     val zero : t
10 |   end
11 | 
12 | module type WORDS =
13 |   sig
14 |     module K:COSTS
15 |     type t
16 |     type letter
17 |     val length : t -> int
18 |     val get : t -> int -> letter
19 |     val distance : letter option -> letter option -> K.t
20 |   end
21 |       
22 | module Make(A:WORDS) =
23 |   struct
24 |     module K = A.K
25 |     let distance s t =
26 |       let m = A.length s and
27 |           n = A.length t in
28 |       let a = Array.make ((m + 1) * (n + 1)) K.zero in
29 |       let put i j x =
30 |         begin
31 |           assert (0 <= i && i <= m && 0 <= j && j <= n);
32 |           a.((n + 1) * i + j) <- x
33 |         end
34 |       and take i j =
35 |         begin
36 |           assert (0 <= i && i <= m && 0 <= j && j <= n);
37 |           a.((n + 1) * i + j)
38 |         end
39 |       in
40 |       begin
41 |         put 0 0 K.zero;
42 |         for i = 1 to m do
43 |           put i 0 (K.sum (take (i - 1) 0) (A.distance None (Some(A.get s (i - 1)))))
44 |         done;
45 |         for j = 1 to n do
46 |           put 0 j (K.sum (take 0 (j - 1)) (A.distance (Some(A.get t (j - 1))) None))
47 |         done;
48 |         for i = 0 to m - 1 do
49 |           for j = 0 to n - 1 do
50 |             let x1 = K.sum (take i       (j + 1)) (A.distance (Some (A.get s i)) None)
51 |             and x2 = K.sum (take (i + 1) j      ) (A.distance (Some (A.get t j)) None)
52 |             and x3 = K.sum (take i       j      )       (A.distance (Some (A.get s i)) (Some (A.get t j)))
53 |             in
54 |             let x = K.min x1 (K.min x2 x3) in
55 |             put (i + 1) (j + 1) x
56 |           done
57 |         done;
58 |         take m n
59 |       end
60 |   end
61 | 
62 | module Float_cost =
63 |   struct
64 |     type t = float
65 |     let min = min
66 |     let sum = (+.)
67 |     let zero = 0.0
68 |   end
69 | 
70 | module String_words =
71 |   struct
72 |     module K = Float_cost
73 |     type t = string
74 |     type letter = char
75 |     let length = String.length
76 |     let get = String.get
77 |     let distance = Qwerty.qwerty_distance
78 |     (*let distance c1 c2 =
79 |       match (c1,c2) with
80 |       | None, None -> 0.0
81 |       | Some _, None -> 1.0
82 |       | None, Some _ -> 1.0
83 |       | Some c1, Some c2 ->
84 |          if c1 = c2 then
85 |            0.0
86 |          else
87 |            1.0*)
88 |   end
89 |     
90 | module Levenshtein_string = Make(String_words)
91 | 


--------------------------------------------------------------------------------
/ecmarex.peg:
--------------------------------------------------------------------------------
  1 | start ::= <Regexp> rx_pattern </Regexp> EOF;
  2 | 
  3 | rx_pattern ::= rx_disjunction;
  4 | 
  5 | rx_disjunction ::= <Or>rx_alternative '|' rx_disjunction</Or> | rx_alternative;
  6 | 
  7 | rx_alternative ::= rx_term rx_alternative | epsilon;
  8 | 
  9 | rx_term ::= rx_assertion | <Quantified>rx_atom rx_quantifier</Quantified> | rx_atom;
 10 | 
 11 | rx_assertion ::= <Begin/>"^" | <End/>"$" | <Word/>"\\b" | <WORD/>"\\B";
 12 | 
 13 | rx_quantifier ::=
 14 |     <Question> rx_quantifier_prefix '?' </Question>
 15 |   | rx_quantifier_prefix
 16 | ;
 17 | 
 18 | rx_quantifier_prefix ::=
 19 |     <Star/> '*'
 20 |   | <Plus/> '+'
 21 |   | <Opt/> '?'
 22 |   | <Range> '{' start:[0-9]+ (',' end:[0-9]*)? '}' </Range>
 23 | ;
 24 | 
 25 | rx_atom ::=
 26 |     <Atom>value:rx_pattern_char+</Atom>
 27 |   | <Sigma/>'.'
 28 |   | '(' <And>"?=" rx_disjunction</And>')'
 29 |   | '(' <Not>"?!" rx_disjunction</Not> ')'
 30 |   | '(' <Ignore>"?:" rx_disjunction</Ignore> ')'
 31 |   | '(' <Group>rx_disjunction</Group> ')'
 32 |   | '\\' rx_atom_escape
 33 |   | rx_character_class
 34 | ;
 35 | 
 36 | rx_pattern_char ::= ~[$\\.*+?()\[\]{}|^] sigma;
 37 | 
 38 | rx_atom_escape ::=
 39 |   <AtomEscape>
 40 |     ( rx_decimal_escape
 41 |     | rx_character_escape
 42 |     | rx_character_class_escape
 43 |     | rx_identity_escape )
 44 |   </AtomEscape>
 45 | ;
 46 | 
 47 | rx_identity_escape ::= '\\' <Identity>value:sigma</Identity>;
 48 | 
 49 | rx_class_escape ::=
 50 |     rx_character_class_escape
 51 |   | rx_decimal_escape
 52 |   | 'b'
 53 |   | rx_character_escape
 54 | ;
 55 | 
 56 | rx_character_escape ::=
 57 |     <Escape>[fnrtv]</Escape>
 58 |   | <Control>'c' value:[a-zA-Z]</Control>
 59 |   | <Hex>'x' value:[0-9a-fA-F][0-9a-fA-F]</Hex>
 60 |   | <Unicode>'u' value:[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]</Unicode>
 61 |   | <Atom>value:sigma</Atom>
 62 | ;
 63 | 
 64 | rx_decimal_escape ::= <Decimal>value:[0-9]+</Decimal>;
 65 | 
 66 | rx_character_class_escape ::=
 67 |     <Digits/> 'd'
 68 |   | <NotDigits/> 'D'
 69 |   | <Space/> 's'
 70 |   | <NotSpace/> 'S'
 71 |   | <Word/> 'w'
 72 |   | <NotWord/> 'W'
 73 | ;
 74 | 
 75 | rx_character_class ::= 
 76 |     '[' '^' <DontMatch> rx_class_ranges </DontMatch> ']'
 77 |   | '[' <Match> rx_class_ranges </Match> ']'
 78 | ;
 79 | 
 80 | rx_class_ranges ::= rx_nonempty_class_ranges?;
 81 | 
 82 | rx_nonempty_class_ranges ::=
 83 |     <Range>rx_class_atom '-' rx_class_atom</Range> rx_class_ranges
 84 |   | rx_class_atom rx_nonempty_class_ranges_no_dash
 85 |   | rx_class_atom
 86 | ;
 87 | 
 88 | rx_nonempty_class_ranges_no_dash ::=
 89 |     <Range>rx_class_atom_no_dash '-' rx_class_atom</Range> rx_class_ranges
 90 |   | rx_class_atom rx_nonempty_class_ranges_no_dash
 91 |   | rx_class_atom
 92 | ;
 93 | 
 94 | rx_class_atom ::=
 95 |     '-'
 96 |   | rx_class_atom_no_dash
 97 | ;
 98 | 
 99 | rx_class_atom_no_dash ::=
100 |     '\\' rx_class_escape
101 |   | <Char>value:rx_source_char</Char>
102 | ;
103 | 
104 | rx_source_char ::= ~[\\\]\-] sigma;
105 | 


--------------------------------------------------------------------------------
/source.ml:
--------------------------------------------------------------------------------
  1 | (* Source *)
  2 | 
  3 | open Ast;;
  4 | open Conduit;;
  5 | 
  6 | type treatment = Ign|Wrn|Err;;
  7 | type view = Pos|Txt;;
  8 | 
  9 | type source = {
 10 |   s_file : string;
 11 |   s_text : string;
 12 |   s_source : program;
 13 |   s_liner : Liner.t;
 14 |   s_ignorify : bool;
 15 |   s_warnify : bool
 16 | };;
 17 | 
 18 | type position = int * int;;
 19 | 
 20 | module PS = Set.Make(struct type t = position let compare = compare end);;
 21 | 
 22 | (*** scribe_position *)
 23 | let scribe_position liner cd oc (i,j) =
 24 |   let j = j - 1 in
 25 |   let l_i = Liner.position_to_line liner i
 26 |   and l_j = Liner.position_to_line liner j
 27 |   in
 28 |   let (s_i, e_i) = Liner.line_to_range liner l_i
 29 |   and (s_j, _) = Liner.line_to_range liner l_j
 30 |   in
 31 |   let c_i = i - s_i
 32 |   and c_j = j - s_j
 33 |   in
 34 |   if l_i = l_j then
 35 |     if j = e_i - 1 then
 36 |       cd.cd_print oc "line %d" (l_i + 1)
 37 |     else
 38 |       if c_i = c_j then
 39 |         cd.cd_print oc "line %d, column %d" (l_i + 1) c_i
 40 |       else
 41 |         cd.cd_print oc "line %d, columns %d to %d" (l_i + 1) c_i c_j
 42 |   else
 43 |     cd.cd_print oc "line %d, column %d to line %d, column %d" (l_i + 1) c_i (l_j + 1) c_j
 44 | ;;
 45 | (* ***)
 46 | (*** scribe_position_set *)
 47 | let scribe_position_set liner cd oc set =
 48 |   cd.cd_print oc "{";
 49 |   let first = ref true in
 50 |   PS.iter
 51 |     begin fun pos ->
 52 |       if !first then
 53 |         first := false
 54 |       else
 55 |         cd.cd_print oc ";";
 56 | 
 57 |       cd.cd_print oc " %a" (scribe_position liner cd) pos
 58 |     end
 59 |     set;
 60 |   cd.cd_print oc " }"
 61 | ;;
 62 | (* ***)
 63 | (*** slice_left *)
 64 | let slice_left u i =
 65 |   let m = String.length u in
 66 |   if i <= 0 then
 67 |     ("", u)
 68 |   else
 69 |     if i >= m then
 70 |       (u, "")
 71 |     else
 72 |       (String.sub u 0 i, String.sub u i (m - i))
 73 | ;;
 74 | (* ***)
 75 | (*** slice_right *)
 76 | let slice_right u i =
 77 |   let m = String.length u in
 78 |   if i <= 0 then
 79 |     (u, "")
 80 |   else
 81 |     if i >= m then
 82 |       ("", u)
 83 |     else
 84 |       (String.sub u 0 (m - i), String.sub u (m - i) i)
 85 | ;;
 86 | (* ***)
 87 | (*** extract_lines *)
 88 | let extract_lines liner text start_pos end_pos =
 89 |   let l_i = Liner.position_to_line liner start_pos
 90 |   and l_j = Liner.position_to_line liner (end_pos - 1)
 91 |   in
 92 |   let m = l_j - l_i + 1 in
 93 |   Array.init m
 94 |     begin fun i ->
 95 |       let l = l_i + i in
 96 |       let (x, y) = Liner.line_to_range liner l in
 97 |       let u = String.sub text x (y - x) in
 98 |       let (prefix, u) =
 99 |         if l = l_i then
100 |           let c_i = start_pos - x in
101 |           slice_left u c_i
102 |         else
103 |           "", u
104 |       in
105 |       let (u, suffix) =
106 |         if l = l_j then
107 |           let c_j = y - end_pos in
108 |           slice_right u c_j
109 |         else
110 |           u, ""
111 |       in
112 |       (l, prefix, u, suffix)
113 |     end
114 | (* ***)
115 | 


--------------------------------------------------------------------------------
/ast.ml:
--------------------------------------------------------------------------------
  1 | (* AST *)
  2 | 
  3 | open Conduit;;
  4 | 
  5 | type info = {
  6 |   i_start : int;
  7 |   i_end : int;
  8 |   i_extra : bool
  9 | };;
 10 | 
 11 | let version = 8;;
 12 | 
 13 | type program = source_element list
 14 | and source_element =
 15 | | St of int * int * st
 16 | | FunDecl of int * int * func
 17 | and block = st list
 18 | and st =
 19 | | Position of int * int * st
 20 | | Expr of expr
 21 | | If of expr * st * st option
 22 | | Do of st * expr
 23 | | While of expr * st
 24 | | For of st option * st option * st option * st
 25 | | Continue of label option
 26 | | Break of label option
 27 | | Return of expr option
 28 | | With of expr * st
 29 | | Labeled of label * st
 30 | | Switch of expr * (case_clause list * st) list
 31 | | Throw of expr
 32 | | Try of st * (arg * st) option * st option
 33 | | Variable of variable_declaration list
 34 | | Block of st list
 35 | | ForIn of lhs_or_var * expr * st
 36 | | Nop
 37 | and lhs_or_var =
 38 | | LHS of expr
 39 | | Vars of variable_declaration list
 40 | and variable_declaration = name * expr option
 41 | and case_clause = Default | Case of expr
 42 | and func = name option * name list * source_element list
 43 | and extra = int * int * extra_tag
 44 | and extra_tag =
 45 | | DanglingComma
 46 | and expr =
 47 | | Assign of expr * assignment_operator * expr
 48 | | Sq of expr list
 49 | | Function of int * int * func
 50 | | L of litteral
 51 | | U of unop * expr
 52 | | B of binop * expr * expr
 53 | | V of name
 54 | | Object of (property_name * expr) list
 55 | | Array of array_litteral
 56 | | Apply of expr * expr list
 57 | | Conditional of expr * expr * expr
 58 | | This
 59 | | Extra of extra
 60 | and property_name =
 61 | | PN_String of string
 62 | | PN_Float of float
 63 | | PN_Int of int32
 64 | | PN_Empty
 65 | and binop =
 66 | | B_mul
 67 | | B_div
 68 | | B_mod
 69 | | B_add
 70 | | B_sub
 71 | | B_le
 72 | | B_ge
 73 | | B_lt
 74 | | B_gt
 75 | | B_instanceof
 76 | | B_in
 77 | | B_equal
 78 | | B_lsr
 79 | | B_asr
 80 | | B_lsl
 81 | | B_notequal
 82 | | B_physequal
 83 | | B_physnotequal
 84 | | B_bitand
 85 | | B_bitor
 86 | | B_bitxor
 87 | | B_and
 88 | | B_or
 89 | | B_bracket
 90 | and unop =
 91 | | U_bitnot
 92 | | U_delete
 93 | | U_void
 94 | | U_typeof
 95 | | U_pre_increment
 96 | | U_pre_decrement
 97 | | U_post_increment
 98 | | U_post_decrement
 99 | | U_plus
100 | | U_minus
101 | | U_not
102 | | U_new
103 | and assignment_operator =
104 | | A_eq
105 | | A_mul
106 | | A_div
107 | | A_mod
108 | | A_add
109 | | A_sub
110 | | A_lsl
111 | | A_lsr
112 | | A_asr
113 | | A_and
114 | | A_xor
115 | | A_or
116 | and litteral =
117 | | Float of float
118 | | Int of int32
119 | | String of string
120 | | Regexp of string * string
121 | | Bool of bool
122 | | Null
123 | | Undefined
124 | and array_litteral = expr list
125 | and name = string
126 | and arg = string
127 | and label = string
128 | 
129 | let info0 = { i_start = 0; i_end = max_int; i_extra = true };;
130 | 
131 | let rec iter_over_expr_in_program info f p = List.iter (iter_over_expr_in_source_element info f) p
132 | and iter_over_expr_in_source_element info f = function
133 | | St(start_pos, end_pos, s) -> iter_over_expr_in_st { info with i_start = start_pos; i_end = end_pos } f s
134 | | FunDecl(_,_,(_,_,sl)) -> iter_over_expr_in_program info f sl
135 | and iter_over_expr_in_sto info f = function
136 | | None -> ()
137 | | Some s -> iter_over_expr_in_st info f s
138 | and iter_over_expr_in_variable_declaration_list info f vl =
139 |   List.iter (fun (_, xo) ->
140 |     match xo with
141 |     | None -> ()
142 |     | Some x -> f info x) vl
143 | and iter_over_expr_in_st info f = function
144 | | Position(start_pos, end_pos, s) -> iter_over_expr_in_st { info with i_start = start_pos; i_end = end_pos } f s
145 | | Expr x -> f info x
146 | | If(x, s1, so) -> f info x; iter_over_expr_in_st info f s1;
147 |   begin
148 |     match so with
149 |     | None -> ()
150 |     | Some s -> iter_over_expr_in_st info f s
151 |   end
152 | | Do(s, x)|While(x,s)|With(x,s) -> iter_over_expr_in_st info f s; f info x
153 | | For(so1, so2, so3, s) ->
154 |     iter_over_expr_in_sto info f so1;
155 |     iter_over_expr_in_sto info f so2;
156 |     iter_over_expr_in_sto info f so3;
157 |     iter_over_expr_in_st info f s
158 | | Return(Some x)|Throw x -> f info x
159 | | Continue _|Break _|Return None -> ()
160 | | Labeled(_, s) -> iter_over_expr_in_st info f s
161 | | Switch(x, cls) ->
162 |     f info x;
163 |     List.iter
164 |       begin fun (cl, s) ->
165 |         iter_over_expr_in_st info f s;
166 |         List.iter
167 |           begin function
168 |             | Default -> ()
169 |             | Case x -> f info x
170 |           end
171 |           cl
172 |       end
173 |       cls
174 | | Try(s, aso, so) ->
175 |     iter_over_expr_in_st info f s;
176 |     begin
177 |       match aso with
178 |       | None -> ()
179 |       | Some(_, s) -> iter_over_expr_in_st info f s
180 |     end;
181 |     begin
182 |       match so with
183 |       | None -> ()
184 |       | Some s -> iter_over_expr_in_st info f s
185 |     end
186 | | Variable vl -> iter_over_expr_in_variable_declaration_list info f vl
187 | | Block sl -> List.iter (iter_over_expr_in_st info f) sl
188 | | ForIn(l, x, s) ->
189 |     f info x;
190 |     iter_over_expr_in_lhs info f l;
191 |     iter_over_expr_in_st info f s
192 | | Nop -> ()
193 | and iter_over_expr_in_lhs info f = function
194 | | LHS x -> f info x
195 | | Vars vl -> iter_over_expr_in_variable_declaration_list info f vl
196 | ;;
197 | 
198 | (*** scribe_property_name *)
199 | let scribe_property_name cd oc = function
200 | | PN_String u -> cd.cd_print oc "%S" u
201 | | PN_Float f -> cd.cd_print oc "%f" f
202 | | PN_Int x -> cd.cd_print oc "%ld" x
203 | | PN_Empty -> cd.cd_print oc "*empty*"
204 | ;;
205 | (* ***)
206 | 


--------------------------------------------------------------------------------
/manual.txt:
--------------------------------------------------------------------------------
  1 | Jsure
  2 | =====
  3 | Copyright(C) 2007 Exalead SA.
  4 | Released under the GNU Library General Public License.
  5 | 
  6 | Description
  7 | ===========
  8 | Jsure is a "lint" for Javascript, which is also known as Ecmascript.
  9 | It checks syntax and a little bit of semantics.
 10 | 
 11 | 
 12 | Usage
 13 | =====
 14 | You run jsure on your source files and jsure spits out ANSI-colored
 15 | warnings and errors with excerpts from your code on your terminal.
 16 | 
 17 |   jsure [options] file_1.js file_2.js ... file_n.js
 18 | 
 19 | This is equivalent to
 20 | 
 21 |   cat file_1.js ... file_n.js > file.js
 22 |   jsure [options] file.js
 23 | 
 24 | except for the reported error locations.
 25 | 
 26 | 
 27 | Actions
 28 | =======
 29 | jsure will read and parse the input files.  If there is any unparseable file,
 30 | it will report an error and stop.
 31 | 
 32 | By default, Jsure will only check the syntax.  For more advanced checking,
 33 | you must use on or more of the following options:
 34 |   -check                : The most useful, all-purpose check (unused vars, etc.)
 35 |   -forbidden-properties : Some property names such as 'name' cause problems;
 36 |                           jsure can detect static instances of those problematic names.
 37 |   -list-props           : Will list all the (static) property names used in the
 38 |                           file.
 39 | 
 40 | Miscellaneous options
 41 | =====================
 42 |   -quiet         Suppress informative messages
 43 |   -no-warnings   Suppress warnings
 44 | 
 45 | Changing behaviour on certain subdirectories
 46 | ============================================
 47 | Errors and warnings produced by source files whose name starts with a prefix
 48 | given by an -ignorify (resp. -warnify) option will be ignored (resp. transformed
 49 | into warnings).
 50 | 
 51 | 
 52 | Detection of anomalies
 53 | ======================
 54 | Anomalies, such as using an uninitialized variable, are legal language
 55 | constructs that are bad coding practice or likely errors.
 56 | 
 57 | Each anomaly has an associated action, which can be changed with a one-letter
 58 | flag by an option.  The actions are ignore (i), warn (w) or error (e).
 59 | 
 60 | 
 61 | Anomalies
 62 | =========
 63 | 
 64 | -toplevel-bindings
 65 |   Setting global properties without a "var".
 66 | 
 67 | -assigning-to-args
 68 |   Assigning to a function argument.
 69 | 
 70 | -uninitialized-vars
 71 |   Using uninitialized variables.  In Javascript, uninitialized variables are set
 72 |   to undefined.
 73 | 
 74 | 
 75 | Unused identifiers
 76 | ==================
 77 | Jsure can detect unused variables (-unused-vars), arguments (-unused-args) or
 78 | functions (-unused-funs).
 79 | 
 80 | Sometimes it is unavoidable to have unused arguments - for example when you have
 81 | to furnish a callback but have no need for all of its arguments.
 82 | 
 83 | Jsure will ignore any variable, argument or function whose name starts with an
 84 | underscore (_) will be ignored.  (The rule for flagging unused variables can be
 85 | changed with the -unused-ident-regexp option.)  Using such a variable is an
 86 | anomaly (-using-unused).
 87 | 
 88 | 
 89 | Summary of anomalies
 90 | ====================
 91 |   -unused-args           Function arguments unused in the body of the function.
 92 |   -using-unused          Using variables or arguments lexically declared to be unused
 93 |   -unused-vars           Unused variables
 94 |   -unused-funs           Unused functions
 95 |   -shadowing-args        Arguments shadowed by variables
 96 |   -dangling-commas       Dangling commas in object and array litterals
 97 | 
 98 | Not yet implemented:
 99 |   -unreachable-code      Unreachable code
100 | 
101 | 
102 | Environment variables
103 | =====================
104 | It is possible to change the behaviour of jsure thru the environment variables
105 | JSURE and JSURE_BEFORE.  These variables define options to be processed before
106 | (JSURE_BEFORE) and after (JSURE) the processing of command-line options.
107 | 
108 | The syntax for the environment variable is a little different than that of the
109 | command-line options.  For instance, the set of command-line options
110 | 
111 |   -toplevel-bindings e -dont-catch
112 | 
113 | would translate to
114 | 
115 | JSURE="toplevel_bindings=e;dont_catch"
116 | 
117 | In other words, the first dash (-) of the option names is to be removed,
118 | remaining dashes are to be replaced by underscores (_), options are to
119 | be separated by semicolons (;) and an equal sign (=) should separate
120 | option names from their arguments.
121 | 
122 | 
123 | Excerpts and colorization
124 | =========================
125 | Jsure can show the context surrounding errors.  This is settable with the
126 | -errors option: -errors t will display text, -errors p will only display the
127 | error position.  The same thing applies to warnings with the -warnings option.
128 | 
129 | Jsure can also brighten up your life by partially colorizing error or warning
130 | messages.  These colors can be configured using the following options:
131 | 
132 |   -info-color <color>     Info color
133 |   -warning-color <color>  Warning color
134 |   -error-color <color>    Error color
135 |   -number-color <color>   Line number color
136 |   -code-color <color>     Code color
137 |   -hl-color <color>       Code highlight color
138 | 
139 | Here, <color> is one of;
140 |   black
141 |   red
142 |   green
143 |   yellow
144 |   blue
145 |   magenta
146 |   cyan
147 |   white
148 |   none
149 | 
150 | and will produce corresponding ANSI escape sequences, which may or may not,
151 | given the configuration of your terminal, produce the expected colors.
152 | 
153 | 
154 | Caching parse trees
155 | ===================
156 | To accelerate parsing, use the -cache <filename> option;  jsure will then
157 | cache parse trees in the file <filename>.dir, which will also be linked to
158 | <filename>.pag (this behaviour is defined by your system's DBM library).
159 | 


--------------------------------------------------------------------------------
/ecmalexer.lex:
--------------------------------------------------------------------------------
  1 | %{
  2 | #include "ecmaparser.tab.h"
  3 | #include "ast.h"
  4 | #include <stdlib.h>
  5 | #include <string.h>
  6 |   #undef YY_INPUT
  7 | 
  8 | #define YY_INPUT(buf, result, max_size) do {                                    \
  9 |   if (js_parser_input_buffer_pos < js_parser_input_buffer_size) {               \
 10 |     unsigned int size =                                                         \
 11 |     (js_parser_input_buffer_pos + (unsigned int) max_size < js_parser_input_buffer_size) ?     \
 12 |       (unsigned int) max_size : (unsigned int) (js_parser_input_buffer_size - js_parser_input_buffer_pos);      \
 13 |     memcpy(buf, js_parser_input_buffer, size);                               \
 14 |     js_parser_input_buffer_pos += size;                                         \
 15 |     result = size;                                                                \
 16 |   } else {                                                                      \
 17 |     buf[0] = EOF; \
 18 |     result = 0;                                                                \
 19 |   }                                                                             \
 20 | } while(0)
 21 | 
 22 | %}
 23 | %%
 24 | 
 25 | "\x09"		{}
 26 | "\x0B"		{}
 27 | "\x0C"		{}
 28 | "\x20"		{}
 29 | "\xA0"		{}
 30 | "\x0A"		{}
 31 | "\x0D"		{}
 32 | 
 33 | "<!--" {}
 34 | 
 35 | \/\/.* {}
 36 | 
 37 | \/\*(.|\\n)*\*\/ {}
 38 | 
 39 | (0|([1-9][0-9]*))	{
 40 | 			yylval.numeric_literal_value.value_type = INTVALUETYPE;
 41 | 			yylval.numeric_literal_value.int_value = atoi(yytext);
 42 | 			return NUMERICLITERAL;
 43 | 			}
 44 | 
 45 | (0|([1-9][0-9]*))(e|E)(\+|-)?[0-9]* 	{} 
 46 | 
 47 | (0|([1-9][0-9]*))\.[0-9]+ 	{
 48 | 				yylval.numeric_literal_value.value_type = FLOATVALUETYPE;
 49 | 				yylval.numeric_literal_value.float_value = atof(yytext);
 50 | 				return NUMERICLITERAL;
 51 | 				}
 52 | 
 53 | (0|([1-9][0-9]*))(\.[0-9]+)?((e|E)(\+|-)?[0-9]*)? {}
 54 | 
 55 | 0x[0-9A-F]*		{}
 56 | 
 57 | \"([^\"]|\\(\"|b|f|n|r|t|v))*\" 	{
 58 | 				int size = (int) strlen(yytext);
 59 | 	                        char * str = malloc(size-1);
 60 | 	                        strncpy(str,yytext+1,size-2);
 61 | 				str[size-2]='\0';
 62 | 				yylval.string_value = str;
 63 | 				return STRINGLITERAL;
 64 | 				}
 65 | 
 66 | '([^\']|\\(\"|b|f|n|r|t|v))*' 	{
 67 | 				int size = (int) strlen(yytext);
 68 |                                 char * str = malloc(size-1);
 69 |                                 strncpy(str,yytext+1,size-2);
 70 | 	                   	str[size-2]='\0';
 71 | 				yylval.string_value = str;
 72 | 				return STRINGLITERAL;
 73 | 				}
 74 | 												
 75 | "true"			{
 76 | 			yylval.literal_value.value_type = BOOLVALUETYPE;
 77 | 			yylval.literal_value.bool_value = 1;
 78 | 			return LITERAL;
 79 | 			}
 80 | 
 81 | "false"			{
 82 | 			yylval.literal_value.value_type = BOOLVALUETYPE;
 83 | 			yylval.literal_value.bool_value = 0;
 84 | 			return LITERAL;
 85 | 			}
 86 | 
 87 | "null"			{
 88 | 			yylval.literal_value.value_type = NULLVALUETYPE;
 89 | 			yylval.literal_value.null_value = 1;
 90 | 			return LITERAL;
 91 | 			}
 92 | 
 93 | "break" 	{return BREAK;}
 94 | "case"		{return CASE;}
 95 | "catch"		{return CATCH;}
 96 | "continue"	{return CONTINUE;}
 97 | "default"	{return DEFAULT;}
 98 | "delete"	{return DELETE;}
 99 | "do"		{return DO;}
100 | "else"		{return ELSE;}
101 | "finally"	{return FINALLY;}
102 | "for"		{return FOR;}
103 | "function"	{return FUNCTION;}
104 | "if"		{return IF;}
105 | "in"		{return IN;}
106 | "instanceof"	{return INSTANCEOF;}
107 | "new"		{return NEW;}
108 | "return"	{return RETURN;}
109 | "switch"	{return SWITCH;}
110 | "this"		{return THIS;}
111 | "throw"		{return THROW;}
112 | "try"		{return TRY;}
113 | "typeof"	{return TYPEOF;}
114 | "var"		{return VAR;}
115 | "void"		{return VOID;}
116 | "while"		{return WHILE;}
117 | "with"		{return WITH;}
118 | 
119 | "abstract"	{}
120 | "boolean"	{}
121 | "byte"		{}
122 | "char"		{}
123 | "class"		{}
124 | "const"		{}
125 | "debugger"	{}
126 | "enum"		{}
127 | "export"	{}
128 | "extends"	{}
129 | "final"		{}
130 | "float"		{}
131 | "goto"		{}
132 | "implements"	{}
133 | "int"		{}
134 | "interface"	{}
135 | "long"		{}
136 | "native"	{}
137 | "package"	{}
138 | "private"	{}
139 | "protected"	{}
140 | "short"		{}
141 | "static"	{}
142 | "super"		{}
143 | "synchronized"	{}
144 | "throws"	{}
145 | "transient"	{}
146 | "volatile"	{}
147 | "double"	{}
148 | "import"	{}
149 | "public"	{}
150 | 
151 | "{"		{return LBRACK;}
152 | "}"		{return RBRACK;}
153 | "("		{return LPAR;}
154 | ")"		{return RPAR;}
155 | "["		{return LCRO;}
156 | "]"		{return RCRO;}
157 | "."		{return DOT;}
158 | ";"		{return DOTCOM;}
159 | ","		{return COMA;}
160 | "<"		{return L;}
161 | ">"		{return R;}
162 | "<="		{return LEQ;}
163 | ">="		{return REQ;}
164 | "=="		{return EQEQ;}
165 | "!="		{return NOTEQ;}
166 | "==="		{return EQEQEQ;}
167 | "!=="		{return NOTEQEQ;}
168 | "+"		{return PLUS;}
169 | "-"		{return MINUS;}
170 | "*"		{return TIMES;}
171 | "%"		{return MOD;}
172 | "++"		{return PLUSPLUS;}
173 | "--"		{return MINUSMINUS;}
174 | "<<"		{return LL;}
175 | ">>"		{return RR;}
176 | ">>>"		{return RRR;}
177 | "&"		{return AND;}
178 | "|"		{return OR;}
179 | "^"		{return HAT;}
180 | "!"		{return EXCL;}
181 | "~"		{return TILDE;}
182 | "&&"		{return ANDAND;}
183 | "||"		{return OROR;}
184 | "?"		{return QUESTION;}
185 | ":"		{return DOTDOT;}
186 | "="		{return EQ;}
187 | "+="		{return PLUSEQ;}
188 | "-="		{return MINUSEQ;}
189 | "*="		{return TIMESEQ;}
190 | "%="		{return MODEQ;}
191 | "<<="		{return LLEQ;}
192 | ">>="		{return RREQ;}
193 | ">>>="		{return RRREQ;}
194 | "&="		{return ANDEQ;}
195 | "|="		{return OREQ;}
196 | "^="		{return HATEQ;}
197 | "/"		{return DIV;}
198 | "/="		{return DIVEQ;}
199 | 
200 | ([A-Z]|[a-z]|$|_)+[0-9]?        {
201 | 				int size = (int) strlen(yytext);
202 | 				char * str = malloc(size+1);
203 | 				strncpy(str,yytext,size);
204 |                                 str[size] = '\0';
205 | 				yylval.string_value = str;
206 | 				return IDENTIFIER;
207 | 	                        }
208 | %%
209 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
  1 | 		   GNU LESSER GENERAL PUBLIC LICENSE
  2 |                        Version 3, 29 June 2007
  3 | 
  4 |  Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
  5 |  Everyone is permitted to copy and distribute verbatim copies
  6 |  of this license document, but changing it is not allowed.
  7 | 
  8 | 
  9 |   This version of the GNU Lesser General Public License incorporates
 10 | the terms and conditions of version 3 of the GNU General Public
 11 | License, supplemented by the additional permissions listed below.
 12 | 
 13 |   0. Additional Definitions. 
 14 | 
 15 |   As used herein, "this License" refers to version 3 of the GNU Lesser
 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU
 17 | General Public License.
 18 | 
 19 |   "The Library" refers to a covered work governed by this License,
 20 | other than an Application or a Combined Work as defined below.
 21 | 
 22 |   An "Application" is any work that makes use of an interface provided
 23 | by the Library, but which is not otherwise based on the Library.
 24 | Defining a subclass of a class defined by the Library is deemed a mode
 25 | of using an interface provided by the Library.
 26 | 
 27 |   A "Combined Work" is a work produced by combining or linking an
 28 | Application with the Library.  The particular version of the Library
 29 | with which the Combined Work was made is also called the "Linked
 30 | Version".
 31 | 
 32 |   The "Minimal Corresponding Source" for a Combined Work means the
 33 | Corresponding Source for the Combined Work, excluding any source code
 34 | for portions of the Combined Work that, considered in isolation, are
 35 | based on the Application, and not on the Linked Version.
 36 | 
 37 |   The "Corresponding Application Code" for a Combined Work means the
 38 | object code and/or source code for the Application, including any data
 39 | and utility programs needed for reproducing the Combined Work from the
 40 | Application, but excluding the System Libraries of the Combined Work.
 41 | 
 42 |   1. Exception to Section 3 of the GNU GPL.
 43 | 
 44 |   You may convey a covered work under sections 3 and 4 of this License
 45 | without being bound by section 3 of the GNU GPL.
 46 | 
 47 |   2. Conveying Modified Versions.
 48 | 
 49 |   If you modify a copy of the Library, and, in your modifications, a
 50 | facility refers to a function or data to be supplied by an Application
 51 | that uses the facility (other than as an argument passed when the
 52 | facility is invoked), then you may convey a copy of the modified
 53 | version:
 54 | 
 55 |    a) under this License, provided that you make a good faith effort to
 56 |    ensure that, in the event an Application does not supply the
 57 |    function or data, the facility still operates, and performs
 58 |    whatever part of its purpose remains meaningful, or
 59 | 
 60 |    b) under the GNU GPL, with none of the additional permissions of
 61 |    this License applicable to that copy.
 62 | 
 63 |   3. Object Code Incorporating Material from Library Header Files.
 64 | 
 65 |   The object code form of an Application may incorporate material from
 66 | a header file that is part of the Library.  You may convey such object
 67 | code under terms of your choice, provided that, if the incorporated
 68 | material is not limited to numerical parameters, data structure
 69 | layouts and accessors, or small macros, inline functions and templates
 70 | (ten or fewer lines in length), you do both of the following:
 71 | 
 72 |    a) Give prominent notice with each copy of the object code that the
 73 |    Library is used in it and that the Library and its use are
 74 |    covered by this License.
 75 | 
 76 |    b) Accompany the object code with a copy of the GNU GPL and this license
 77 |    document.
 78 | 
 79 |   4. Combined Works.
 80 | 
 81 |   You may convey a Combined Work under terms of your choice that,
 82 | taken together, effectively do not restrict modification of the
 83 | portions of the Library contained in the Combined Work and reverse
 84 | engineering for debugging such modifications, if you also do each of
 85 | the following:
 86 | 
 87 |    a) Give prominent notice with each copy of the Combined Work that
 88 |    the Library is used in it and that the Library and its use are
 89 |    covered by this License.
 90 | 
 91 |    b) Accompany the Combined Work with a copy of the GNU GPL and this license
 92 |    document.
 93 | 
 94 |    c) For a Combined Work that displays copyright notices during
 95 |    execution, include the copyright notice for the Library among
 96 |    these notices, as well as a reference directing the user to the
 97 |    copies of the GNU GPL and this license document.
 98 | 
 99 |    d) Do one of the following:
100 | 
101 |        0) Convey the Minimal Corresponding Source under the terms of this
102 |        License, and the Corresponding Application Code in a form
103 |        suitable for, and under terms that permit, the user to
104 |        recombine or relink the Application with a modified version of
105 |        the Linked Version to produce a modified Combined Work, in the
106 |        manner specified by section 6 of the GNU GPL for conveying
107 |        Corresponding Source.
108 | 
109 |        1) Use a suitable shared library mechanism for linking with the
110 |        Library.  A suitable mechanism is one that (a) uses at run time
111 |        a copy of the Library already present on the user's computer
112 |        system, and (b) will operate properly with a modified version
113 |        of the Library that is interface-compatible with the Linked
114 |        Version. 
115 | 
116 |    e) Provide Installation Information, but only if you would otherwise
117 |    be required to provide such information under section 6 of the
118 |    GNU GPL, and only to the extent that such information is
119 |    necessary to install and execute a modified version of the
120 |    Combined Work produced by recombining or relinking the
121 |    Application with a modified version of the Linked Version. (If
122 |    you use option 4d0, the Installation Information must accompany
123 |    the Minimal Corresponding Source and Corresponding Application
124 |    Code. If you use option 4d1, you must provide the Installation
125 |    Information in the manner specified by section 6 of the GNU GPL
126 |    for conveying Corresponding Source.)
127 | 
128 |   5. Combined Libraries.
129 | 
130 |   You may place library facilities that are a work based on the
131 | Library side by side in a single library together with other library
132 | facilities that are not Applications and are not covered by this
133 | License, and convey such a combined library under terms of your
134 | choice, if you do both of the following:
135 | 
136 |    a) Accompany the combined library with a copy of the same work based
137 |    on the Library, uncombined with any other library facilities,
138 |    conveyed under the terms of this License.
139 | 
140 |    b) Give prominent notice with the combined library that part of it
141 |    is a work based on the Library, and explaining where to find the
142 |    accompanying uncombined form of the same work.
143 | 
144 |   6. Revised Versions of the GNU Lesser General Public License.
145 | 
146 |   The Free Software Foundation may publish revised and/or new versions
147 | of the GNU Lesser General Public License from time to time. Such new
148 | versions will be similar in spirit to the present version, but may
149 | differ in detail to address new problems or concerns.
150 | 
151 |   Each version is given a distinguishing version number. If the
152 | Library as you received it specifies that a certain numbered version
153 | of the GNU Lesser General Public License "or any later version"
154 | applies to it, you have the option of following the terms and
155 | conditions either of that published version or of any later version
156 | published by the Free Software Foundation. If the Library as you
157 | received it does not specify a version number of the GNU Lesser
158 | General Public License, you may choose any version of the GNU Lesser
159 | General Public License ever published by the Free Software Foundation.
160 | 
161 |   If the Library as you received it specifies that a proxy can decide
162 | whether future versions of the GNU Lesser General Public License shall
163 | apply, that proxy's public statement of acceptance of any version is
164 | permanent authorization for you to choose that version for the
165 | Library.
166 | 


--------------------------------------------------------------------------------
/generate.ml:
--------------------------------------------------------------------------------
  1 | (* Generate *)
  2 | 
  3 | open Ast;;
  4 | 
  5 | let fp = Format.fprintf;;
  6 | 
  7 | type context =
  8 | | Inner
  9 | | Top
 10 | ;;
 11 | 
 12 | let is_property_safe =
 13 |   let rex = lazy (Str.regexp !Opt.safe_property_regexp) in
 14 |   fun n -> Str.string_match (Lazy.force rex) n 0
 15 | ;;
 16 | 
 17 | let generate f pg =
 18 |   let comma () =
 19 |     let first = ref true in
 20 |     fun () ->
 21 |       if !first then
 22 |         first := false
 23 |       else
 24 |         fp f ",@ "
 25 |   in
 26 |   let semi f colon =
 27 |     match colon with
 28 |     | None -> ()
 29 |     | Some c -> fp f "%c" c
 30 |   in
 31 |   let rec source_element = function
 32 |   | St(_, _, st) ->
 33 |       fp f "@\n";
 34 |       statement ~colon:';' st
 35 |   | FunDecl(_, _, (Some(n), al, sl)) ->
 36 |       fp f "function %s(" n;
 37 |       let c = comma () in
 38 |       List.iter (fun a -> c (); fp f "%s" a) al;
 39 |       fp f ")@ ";
 40 |       block sl
 41 |   | _ -> fp f "/* FunDecl */"
 42 |   and program pg = List.iter source_element pg
 43 |   and block sl =
 44 |     fp f "@[<v2>{@\n";
 45 |     program sl;
 46 |     fp f "@]@\n}"
 47 |   and statement_block ?colon sl =
 48 |     fp f "@[<hov2>{";
 49 |     List.iter (fun s -> statement ~colon:';' s) sl;
 50 |     fp f "@]@\n}%a" semi colon
 51 |   and statement ?colon = function
 52 |     | Throw x -> fp f "throw "; expression Inner x; fp f "%a@\n" semi colon
 53 |     | Labeled(lb, s) -> fp f "%s:@\n" lb; statement ?colon s
 54 |     | Break None -> fp f "break%a@\n" semi colon
 55 |     | Break(Some lb) -> fp f "break %s%a@\n" lb semi colon
 56 |     | Continue None -> fp f "continue%a@\n" semi colon
 57 |     | Continue(Some lb) -> fp f "break %s%a@\n" lb semi colon
 58 |     | With(x, s) ->
 59 |         fp f "with(";
 60 |         expression Top x;
 61 |         fp f ")@ ";
 62 |         statement ?colon s
 63 |     | While(x, s) ->
 64 |         fp f "while(";
 65 |         expression Top x;
 66 |         fp f ")@ ";
 67 |         statement ?colon s
 68 |     | Position(_,_,st) -> statement ?colon st
 69 |     | Expr x -> expression Top x; fp f "%a@\n" semi colon
 70 |     | Variable [] -> () (* XXX *)
 71 |     | Variable vl ->
 72 |         vars ?colon vl
 73 |     | If(x, s, so) ->
 74 |         fp f "@[<hov2>@[<h>if(";
 75 |         expression Top x;
 76 |         fp f ")@]@\n";
 77 |         begin match so with
 78 |           | None ->
 79 |               statement s;
 80 |               fp f "@]%a" semi colon
 81 |           | Some s ->
 82 |               statement ~colon:';' s;
 83 |               fp f "@]";
 84 |               fp f "@ else @[<v2>";
 85 |               statement s;
 86 |               fp f "@]"
 87 |         end
 88 |     | Nop -> ()
 89 |     | Return(Some x) -> fp f "return@ "; expression Inner x; fp f "%a@\n" semi colon
 90 |     | Return None -> fp f "return %a@\n" semi colon
 91 |     | ForIn(LHS x1, x2, st) ->
 92 |         fp f "@[<hov2>for(";
 93 |         expression Inner x1;
 94 |         fp f " in ";
 95 |         expression Inner x2;
 96 |         fp f ")";
 97 |         statement ?colon st;
 98 |         fp f "@\n@]"
 99 |     | ForIn(Vars vdl, x2, st) ->
100 |         fp f "@[<hov2>for(";
101 |         vars vdl;
102 |         fp f " in ";
103 |         expression Inner x2;
104 |         fp f ")";
105 |         statement ?colon st;
106 |         fp f "@\n@]"
107 |     | For(so1, so2, so3, s) ->
108 |         fp f "for(";
109 |         statement_option so1;
110 |         fp f ";@ ";
111 |         statement_option so2;
112 |         fp f ";@ ";
113 |         statement_option so3;
114 |         fp f ")@ ";
115 |         statement s
116 |     | Block sl ->
117 |         fp f "@\n";
118 |         statement_block ?colon sl
119 |     | Try(st, co, fo) ->
120 |         fp f "@[<hov2>try";
121 |         statement st;
122 |         fp f "@\n";
123 |         begin match co with
124 |           | None -> ()
125 |           | Some(a, st) ->
126 |               fp f "@\ncatch(%s)" a;
127 |               statement st
128 |         end;
129 |         begin match fo with
130 |           | None -> ()
131 |           | Some st ->
132 |               fp f "@\nfinally";
133 |               statement st
134 |         end
135 |     | Do(s, x) ->
136 |         fp f "do";
137 |         statement s;
138 |         fp f "while(";
139 |         expression Inner x;
140 |         fp f ")%a" semi colon
141 |      | Switch(x, cls) ->
142 |         fp f "@[<hov2>switch(";
143 |         expression Inner x;
144 |         fp f ") {";
145 |         List.iter
146 |           begin fun (cl, s) ->
147 |             fp f "@\n";
148 |             List.iter clause cl;
149 |             fp f "@\n";
150 |             statement ~colon:';' s
151 |           end
152 |           cls;
153 |         fp f "@\n}@]";
154 |   and vars ?colon vl =
155 |     fp f "@[<hov2>var ";
156 |     let c = comma () in
157 |     List.iter
158 |       begin fun x ->
159 |         c ();
160 |         match x with
161 |         | (n, None) -> fp f "@\n%s" n
162 |         | (n, Some x) -> fp f "@\n%s = " n; expression Top x
163 |       end
164 |       vl;
165 |     fp f "%a" semi colon
166 |   and clause = function
167 |     | Default -> fp f "@\ndefault:"
168 |     | Case x -> fp f "@\ncase "; expression Inner x; fp f ":"
169 |   and statement_option ?colon = function
170 |     | None -> semi f colon
171 |     | Some s -> statement ?colon s
172 |   and expression context x =
173 |     match context, x with
174 |     | _, This -> fp f "this"
175 |     | _, Extra _ -> ()
176 |     | Top, Assign(x1, op, x2) ->
177 |         fp f "@[<hov2>";
178 |         expression Top x1;
179 |         fp f " ";
180 |         begin
181 |           match op with
182 |           | A_eq -> fp f "="
183 |           | A_mul -> fp f "*="
184 |           | A_div -> fp f "/="
185 |           | A_mod -> fp f "%%="
186 |           | A_add -> fp f "+="
187 |           | A_sub -> fp f "-="
188 |           | A_lsl -> fp f "<<="
189 |           | A_lsr -> fp f ">>="
190 |           | A_asr -> fp f ">>>="
191 |           | A_and -> fp f "&="
192 |           | A_or -> fp f "|="
193 |           | A_xor -> fp f "^="
194 |         end;
195 |         fp f "@ ";
196 |         expression Top x2;
197 |         fp f "@]"
198 |     | Top, Sq xl -> List.iter (expression Top) xl
199 |     | _, L l -> litteral l
200 |     | _, V n -> fp f "%s" n
201 |     | Top, Apply(x1, xl) ->
202 |         fp f "@[<hv2>";
203 |         expression Inner x1;
204 |         fp f "(";
205 |         let c = comma () in
206 |         List.iter (fun x -> c (); expression Inner x) xl;
207 |         fp f ")@]"
208 |     | _, Array xl ->
209 |         let c = comma () in
210 |         fp f "@[<h>[";
211 |         List.iter (fun x -> c (); expression Inner x) xl;
212 |         fp f "]@]";
213 |     | Top, Conditional(x1, x2, x3) ->
214 |         fp f "@[<h>";
215 |         expression Top x1;
216 |         fp f " ?@ ";
217 |         expression Top x2;
218 |         fp f " :@ ";
219 |         expression Top x3;
220 |         fp f "@]"
221 |     | Top, Object pl ->
222 |         let c = comma () in
223 |         fp f "@\n@[<hov2>{";
224 |         List.iter
225 |           begin fun (pn, x) ->
226 |             c ();
227 |             fp f "@\n";
228 |             begin
229 |               match pn with
230 |               | PN_Int x -> fp f "%ld" x
231 |               | PN_Float x -> fp f "%f" x
232 |               | PN_String x when is_property_safe x -> fp f "%s" x
233 |               | PN_String x -> fp f "%S" x
234 |               | PN_Empty -> fp f "*empty*"
235 |             end;
236 |             fp f ": ";
237 |             expression Inner x
238 |           end
239 |           pl;
240 |         fp f "@\n@]}"
241 |     | _, Function(_, _, func) -> generate_function func
242 |     | _, B(B_bracket, x1, L(String u)) when is_property_safe u ->
243 |         expression Top x1;
244 |         fp f ".%s" u
245 |     | Top, B(B_bracket, x1, x2) ->
246 |         fp f "@[<h>";
247 |         expression Inner x1;
248 |         fp f "[";
249 |         expression Top x2;
250 |         fp f "]@]"
251 |     | Top, B(op, x1, x2) ->
252 |         fp f "@[<h>";
253 |         expression Inner x1;
254 |         let u =
255 |           match op with
256 |           | B_add -> "+"
257 |           | B_mul -> "*"
258 |           | B_sub -> "-"
259 |           | B_div -> "/"
260 |           | B_equal -> "=="
261 |           | B_notequal -> "!="
262 |           | B_physequal -> "==="
263 |           | B_physnotequal -> "!=="
264 |           | B_bitand -> "&"
265 |           | B_bitor -> "|"
266 |           | B_bitxor -> "^"
267 |           | B_and -> "&&"
268 |           | B_or -> "||"
269 |           | B_le -> "<="
270 |           | B_lt -> "<"
271 |           | B_ge -> ">="
272 |           | B_gt -> ">"
273 |           | B_instanceof -> "instanceof"
274 |           | B_in -> "in"
275 |           | _ -> "/* operator */"
276 |         in
277 |         fp f " %s@ " u;
278 |         expression Inner x2;
279 |         fp f "@]"
280 |     | Top, U(U_post_increment, x) -> expression Inner x; fp f " ++"
281 |     | Top, U(U_post_decrement, x) -> expression Inner x; fp f " --"
282 |     | Top, U(op, x) ->
283 |         let u =
284 |           match op with
285 |           | U_new -> "new"
286 |           | U_delete -> "delete"
287 |           | U_typeof -> "typeof"
288 |           | U_pre_increment -> "++"
289 |           | U_pre_decrement -> "--"
290 |           | U_plus -> "+"
291 |           | U_minus -> "-"
292 |           | U_not -> "!"
293 |           | _ -> assert false
294 |         in
295 |         fp f "%s " u;
296 |         expression Inner x
297 |     | Inner, _ -> fp f "(@["; expression Top x; fp f "@])"
298 |   and generate_function (no, al, sl) =
299 |     fp f "function";
300 |     begin
301 |       match no with
302 |       | None -> fp f "("
303 |       | Some n -> fp f " %s(" n
304 |     end;
305 |     fp f "@[<h>";
306 |     let c = comma () in
307 |     List.iter
308 |       begin fun n ->
309 |         c ();
310 |         fp f "%s" n
311 |       end
312 |       al;
313 |     fp f "@])@ ";
314 |     block sl
315 |   and litteral = function
316 |     | Float x -> fp f "%f" x
317 |     | Int x -> fp f "%ld" x
318 |     | String s -> fp f "%S" s
319 |     | Regexp(r, o) -> fp f "/%s/%s" r o
320 |     | Bool b -> fp f "%b" b
321 |     | Null -> fp f "null"
322 |     | Undefined -> fp f "undefined"
323 |   in
324 |   program pg
325 | ;;
326 | 


--------------------------------------------------------------------------------
/jsure.ml:
--------------------------------------------------------------------------------
  1 | (* JSure *)
  2 | 
  3 | open Pffpsf;;
  4 | 
  5 | module Specs =
  6 |   struct
  7 |     open Arg;;
  8 |     open Opt;;
  9 |     open Source;;
 10 |     
 11 |     let aor x y = x := Some y;;
 12 | 
 13 |     let color x =
 14 |       Symbol(["black";"red";"green";"yellow";"blue";"magenta";"cyan";"white";"none"],
 15 |       begin fun y ->
 16 |         x :=
 17 |           match y with
 18 |             | "black"   -> Ansi.black
 19 |             | "red"     -> Ansi.red
 20 |             | "green"   -> Ansi.green
 21 |             | "yellow"  -> Ansi.yellow
 22 |             | "blue"    -> Ansi.blue
 23 |             | "magenta" -> Ansi.magenta
 24 |             | "cyan"    -> Ansi.cyan
 25 |             | "white"   -> Ansi.white
 26 |             | "none"    -> Ansi.uncoloured
 27 |             | _         -> raise (Bad "Bad color")
 28 |       end)
 29 |     ;;
 30 |     
 31 |     let treatment x =
 32 |       Symbol(["i";"w";"e"],
 33 |       begin function
 34 |         |"i" -> x := Ign
 35 |         |"w" -> x := Wrn
 36 |         |"e" -> x := Err
 37 |         |_ -> raise (Bad "Bad option")
 38 |       end)
 39 |     ;;
 40 | 
 41 |     let visualization x =
 42 |       Symbol(["t";"p"],
 43 |       begin function
 44 |         |"t" -> x := Txt
 45 |         |"p" -> x := Pos
 46 |         |_ -> raise (Bad "Bad option")
 47 |       end)
 48 |     ;;
 49 | 
 50 |     let specs =
 51 |       align [
 52 |         "-cache",
 53 |         String(aor cache),
 54 |         " Set database name for parsing cache";
 55 | 
 56 |         "-just-syntax",
 57 |         Set just_syntax,
 58 |         " Just check the syntax of input files";
 59 | 
 60 |         "-list-props",
 61 |         Set list_props,
 62 |         " List properties accessed";
 63 | 
 64 |         "-minefield",
 65 |         String(aor minefield),
 66 |         "<file> Attempt to detect misspellings of identifiers contained in this file";
 67 | 
 68 |         "-mine-distance",
 69 |         Set_float mine_distance,
 70 |         "<edits> Set minimum distance around mines";
 71 | 
 72 |         "-quiet",
 73 |         Set quiet,
 74 |         " Suppress informative messages";
 75 | 
 76 |         "-no-warnings",
 77 |         Set no_warnings,
 78 |         " Suppress warnings";
 79 | 
 80 |         "-errors",
 81 |         visualization error_visualization,
 82 |         " Show error positions or text bodies";
 83 | 
 84 |         "-warnings",
 85 |         visualization warning_visualization,
 86 |         " Show error warnings or text bodies";
 87 | 
 88 |         "-warnify",
 89 |         String(fun x -> warnify := x :: !warnify),
 90 |         "<prefix> Transform errors into warnings for files whose names start with the given prefix";
 91 | 
 92 |         "-ignorify",
 93 |         String(fun x -> ignorify := x :: !ignorify),
 94 |         "<prefix> Ignore errors and warnings for files whose names start with the given prefix";
 95 | 
 96 |         "-typecheck",
 97 |         Set typecheck,
 98 |         " Attempt to typecheck source files";
 99 | 
100 |         "-forbidden-properties",
101 |         String(aor forbidden_props_file),
102 |         "<file> Load list of forbidden properties from this file";
103 | 
104 |         "-no-check",
105 |         Clear check,
106 |         " Disable basic semantic checks";
107 | 
108 |         "-check",
109 |         Set check,
110 |         " Perform basic semantic checks (on by default)";
111 | 
112 |         "-filenames",
113 |         Set_string filename_regexp,
114 |         "<regexp> Regexp describing valid source filenames";
115 | 
116 |         "-stdin",
117 |         Set read_from_stdin,
118 |         " Read Javascript source from stdin";
119 | 
120 |         "-line-offset",
121 |         Set_int line_number_offset,
122 |         "<n> Add n to reported line numbers";
123 | 
124 |         "-unused-ident-regexp",
125 |         Set_string unused_ident_regexp,
126 |         "<regexp> Regular expression for lexically describing identifiers supposed to be unused";
127 | 
128 |         "-dangling-commas",
129 |         treatment dangling_commas,
130 |         " Dangling commas in object and array litterals";
131 | 
132 |         "-unbound-variables",
133 |         treatment unbound_variables,
134 |         " Assigning to apparently unbound global variables, except in the toplevel";
135 | 
136 |         "-undefined-variables",
137 |         treatment undefined_variables,
138 |         " Referring to global names not obviously declared";
139 | 
140 |         "-toplevel-bindings",
141 |         treatment toplevel_bindings,
142 |         " Setting global properties (without a \"var\")";
143 | 
144 |         "-assigning-to-args",
145 |         treatment assigning_to_args,
146 |         " Assigning to arguments";
147 | 
148 |         "-uninitialized-vars",
149 |         treatment uninitialized_vars,
150 |         " Uninitialized variables";
151 | 
152 |         "-unused-args",
153 |         treatment unused_args,
154 |         " Unused arguments";
155 | 
156 |         "-using-unused",
157 |         treatment using_unused,
158 |         " Using variables or arguments lexically declared to be unused";
159 | 
160 |         "-unused-vars",
161 |         treatment unused_vars,
162 |         " Unused variables";
163 | 
164 |         "-unused-funs",
165 |         treatment unused_funs,
166 |         " Unused functions";
167 | 
168 |         "-shadowing-args",
169 |         treatment shadowing_args,
170 |         " Arguments shadowed by variables";
171 | 
172 |         "-unreachable-code",
173 |         treatment unreachable_code,
174 |         " Unreachable code";
175 | 
176 |         "-bad-regexps",
177 |         treatment bad_regexps,
178 |         " Bad regular expression litterals";
179 | 
180 |         "-dump-env",
181 |         Set dump_env,
182 |         " Dump inferred environments while checking (very verbose)";
183 | 
184 |         "-dump-ast",
185 |         Set dump_ast,
186 |         " Dump AST";
187 | 
188 |         "-dump-raw-ast",
189 |         Set dump_raw_ast,
190 |         " Dump raw AST (marshalled Ocaml data structure)";
191 | 
192 |         "-dont-catch",
193 |         Set dont_catch,
194 |         " Don't catch internal errors (useful for debugging with OCAMLRUNPARAM=b)";
195 | 
196 |         "-generate",
197 |         Set generate,
198 |         " Generate clean JS output";
199 | 
200 |         "-info-color",
201 |         color info_color,
202 |         " Info color";
203 | 
204 |         "-warning-color",
205 |         color warning_color,
206 |         " Warning color";
207 | 
208 |         "-error-color",
209 |         color error_color,
210 |         " Error color";
211 | 
212 |         "-number-color",
213 |         color line_number_color,
214 |         " Line number color";
215 | 
216 |         "-code-color",
217 |         color code_color,
218 |         " Code color";
219 | 
220 |         "-hl-color",
221 |         color code_hl_color,
222 |         " Code highlight color";
223 | 
224 |         "-no-color",
225 |         Unit(fun () -> Ansi.control false),
226 |         " Suppress ANSI color codes in output";
227 | 
228 |         "-version",
229 |         Unit(fun () ->
230 |           let (v1,v2,v3) = Version.version in
231 |           pf "jsure version %d.%d.%d\n" v1 v2 v3;
232 |           exit 0),
233 |         " Display Jsure version"
234 |       ]
235 |     ;;
236 |   end
237 | ;;
238 | 
239 | exception Error of int;;
240 | 
241 | let argv_from_string u =
242 |   let module G = Genlex in
243 |   let lex = G.make_lexer ["=";";"] in
244 |   let s = Stream.of_string u in
245 |   let t = lex s in
246 |   let r = ref [] in
247 |   let loop1 = parser
248 |     | [< '(G.String u|G.Ident u) >] -> u
249 |     | [< '(G.Float f) >] -> sf "%f" f
250 |     | [< '(G.Int i) >] -> sf "%d" i
251 |     | [< '(G.Char c) >] -> sf "%c" c
252 |   in
253 |   let add_option u =
254 |     for j = 0 to String.length u - 1 do
255 |       if u.[j] = '_' then u.[j] <- '-'
256 |     done;
257 |     r := ("-"^u) :: !r
258 |   in
259 |   let rec loop0 = parser
260 |     | [< 'G.Ident u; s >] ->
261 |         begin
262 |           match s with parser
263 |           | [< 'G.Kwd"="; s >] -> add_option u; loop2 s
264 |           | [< 'G.Kwd";"; s >] -> add_option u; loop0 s
265 |         end
266 |     | [< >] -> ()
267 |   and loop2 = parser
268 |     | [< '(G.Kwd";"); s >] -> loop0 s
269 |     | [< y = loop1; s >] ->
270 |         r := y :: !r;
271 |         loop2 s
272 |     | [< >] -> ()
273 |   in
274 |   try
275 |     loop0 t;
276 |     Stream.empty t;
277 |     Array.of_list (List.rev !r)
278 |   with
279 |   | _ -> raise (Error(Stream.count s))
280 | ;;
281 | 
282 | let _ =
283 |   let sources = ref [] in
284 |   let current = ref 0 in
285 |   let arg0 = [|Sys.argv.(0)|] in
286 |   let argr = Array.sub Sys.argv 1 (Array.length Sys.argv - 1) in
287 |   let arg_from_env name =
288 |     try
289 |       let u = Sys.getenv name in
290 |       try
291 |         argv_from_string u
292 |       with
293 |       | Error i ->
294 |           Printf.eprintf "Bad %s environment variable value at character %d.\n%!" name i;
295 |           exit 2
296 |     with
297 |     | Not_found -> [||]
298 |   in
299 |   let arg_pre = arg_from_env "JSURE_BEFORE"
300 |   and arg_post = arg_from_env "JSURE"
301 |   in
302 |   let argv = Array.concat [arg0; arg_pre; argr; arg_post] in
303 |   begin
304 |     try
305 |       Arg.parse_argv
306 |         ~current
307 |         argv
308 |         Specs.specs
309 |         (fun x -> sources := x :: !sources)
310 |         (Printf.sprintf "Usage: %s [options] <sources>" (Filename.basename Sys.argv.(0)));
311 |     with
312 |     | Arg.Help msg ->
313 |         Printf.printf "%s%!" msg;
314 |         exit 0
315 |     | Arg.Bad msg ->
316 |         Printf.printf "%s%!" msg;
317 |         exit 2
318 |   end;
319 |   if !sources = [] && not !Opt.read_from_stdin then
320 |     begin
321 |       Printf.printf "No source files - maybe you should try the -stdin option?\n%!";
322 |       exit 1
323 |     end;
324 |   let res = Process.sources stdout !sources in
325 |   if not !Opt.no_warnings then
326 |     List.iter
327 |       begin fun w ->
328 |         Printf.printf "%sWARNING: %s%s\n" (Ansi.foreground !Opt.warning_color) w (Ansi.none ());
329 |       end
330 |       res.Process.res_warnings;
331 |   let errors = ref false in
332 |   List.iter
333 |     begin fun e ->
334 |       errors := true;
335 |       Printf.printf "%sERROR: %s%s\n" (Ansi.foreground !Opt.error_color) e (Ansi.none ());
336 |     end
337 |     res.Process.res_errors;
338 |   exit (if !errors then 1 else 0)
339 | ;;
340 | 


--------------------------------------------------------------------------------
/convert.ml:
--------------------------------------------------------------------------------
  1 | (* Convert *)
  2 | 
  3 | open Aurochs_pack;;
  4 | open Peg;;
  5 | open Ast;;
  6 | open Ecma;;
  7 | 
  8 | exception Bad_tree of Ecma.tree;;
  9 | exception Bad_trees of Ecma.tree list;;
 10 | 
 11 | let int32_of_string u = Int64.to_int32 (Int64.of_string u);;
 12 | 
 13 | let rec convert = function
 14 |   | Node(N_Root, _, [Node(N_Program, _, sl)]) -> convert_source_elements sl
 15 |   | t -> raise (Bad_tree t)
 16 | and convert_source_elements sl = List.map convert_source_element sl
 17 | and convert_source_element = function
 18 |   | Node(N_St, [A_start, start_pos; A_end, end_pos], [st]) -> St(int_of_string start_pos, int_of_string end_pos, convert_statement st)
 19 |   | Node(N_FunDecl, [A_start, start_pos; A_name, name; A_end, end_pos], [Node(N_Args, [], al); Node(N_Body, _, sl)]) ->
 20 |       FunDecl(int_of_string start_pos, int_of_string end_pos, (Some name, List.map convert_arg al, convert_source_elements sl))
 21 |   | t -> raise (Bad_tree t)
 22 | and convert_arg = function
 23 |   | Node(N_Arg, [A_name, name], []) -> name
 24 |   | t -> raise (Bad_tree t)
 25 | and convert_block stl = Block(List.map convert_statement stl)
 26 | and convert_case = function
 27 |   | Node(N_Case, [], [Node(N_Clauses, [], clauses); Node(N_Body, [], body)]) ->
 28 |       (List.map convert_clause clauses, convert_block body)
 29 |   | t -> raise (Bad_tree t)
 30 | and convert_clause = function
 31 |   | Node(N_Default, [], []) -> Default
 32 |   | Node(N_When, [], [x]) -> Case(convert_expression x)
 33 |   | t -> raise (Bad_tree t)
 34 | and convert_statement = function
 35 |   | Node(N_Position, [A_start, start_pos; A_end, end_pos], [st]) -> Position(int_of_string start_pos, int_of_string end_pos, convert_statement st)
 36 |   | Node(N_Break, [], []) -> Break None
 37 |   | Node(N_Break, [A_label, label], []) -> Break(Some label)
 38 |   | Node(N_Continue, [], []) -> Continue None
 39 |   | Node(N_Label, [A_name, label], [Node(N_Body, [], [st])]) -> Labeled(label, convert_statement st)
 40 |   | Node(N_Continue, [A_label, label], []) -> Continue(Some label)
 41 |   | Node(N_Throw, [], [x]) -> Throw(convert_expression x)
 42 |   | Node(N_Switch, [], x :: cases) -> Switch(convert_expression x, List.map convert_case cases)
 43 |   | Node(N_With, [], [x; Node(N_Body, [], [s])]) -> With(convert_expression x, convert_statement s)
 44 |   | Node(N_EmptyStatement, [], []) -> Nop
 45 |   | Node(N_ExpressionStatement, [], [x]) -> Expr(convert_expression x)
 46 |   | Node(N_Block, [], sl) -> convert_block sl
 47 |   | Node(N_Return, [], [x]) -> Return(Some(convert_expression x))
 48 |   | Node(N_Return, [], []) -> Return None
 49 |   | Node(N_VariableStatement, [], vl) -> Variable(List.map convert_variable_declaration vl)
 50 |   | Node(N_If, [], [Node(N_Condition, [], [x]);
 51 |                     Node(N_True, [], [s1]);
 52 |                     Node(N_False, [], [s2])]) ->
 53 |       If(convert_expression x, convert_statement s1, Some(convert_statement s2))
 54 |   | Node(N_If, [], [Node(N_Condition, [], [x]); Node(N_True, [], [s])]) ->
 55 |       If(convert_expression x, convert_statement s, None)
 56 |   | Node(N_Do, [], [Node(N_Loop, [], [s]); Node(N_Condition, [], [x])]) ->
 57 |       Do(convert_statement s, convert_expression x)
 58 |   | Node(N_While, [], [Node(N_Condition, [], [x]); Node(N_Loop, [], [s])]) ->
 59 |       While(convert_expression x, convert_statement s)
 60 |   | Node(N_ForIn, [], [Node(N_Index, [], [x]);
 61 |                        Node(N_Container, [], [c]);
 62 |                        Node(N_Loop, [], [s])]) ->
 63 |       ForIn(convert_lhs_or_var x, convert_expression c, convert_statement s)
 64 |   | Node(N_For, [], z) ->
 65 |       begin
 66 |         let start, rest =
 67 |           match z with
 68 |           | Node(N_Start, [], [s]) :: rest -> Some(convert_statement s), rest
 69 |           | _ -> None, z
 70 |         in
 71 |         let condition, rest =
 72 |           match rest with
 73 |           | Node(N_Condition, [], [s]) :: rest -> Some(convert_statement s), rest
 74 |           | _ -> None, rest
 75 |         in
 76 |         let next, rest =
 77 |           match rest with
 78 |           | Node(N_Next, [], [s]) :: rest -> Some(convert_statement s), rest
 79 |           | _ -> None, rest
 80 |         in
 81 |         match rest with
 82 |         | [Node(N_Loop, [], [s])] -> For(start, condition, next, convert_statement s)
 83 |         | ts -> raise (Bad_trees ts)
 84 |       end
 85 |   | Node(N_Try, [], (Node(N_Block, [], block)) :: rest) as t ->
 86 |       let block = convert_block block in
 87 |       begin
 88 |         let catch, rest =
 89 |           match rest with
 90 |           | (Node(N_Catch, [], [Node(N_Arg, [A_name, name] , []); Node(N_Body, [], block)])) :: rest -> Some(name, convert_block block), rest
 91 |           | _ -> None, rest
 92 |         in
 93 |         let finally =
 94 |           match rest with
 95 |           | [Node(N_Finally, [], block)] -> Some(convert_block block)
 96 |           | [] -> None
 97 |           | _ -> raise (Bad_tree t)
 98 |         in
 99 |         Try(block, catch, finally)
100 |       end
101 |   | t -> raise (Bad_tree t)
102 | and convert_lhs_or_var = function
103 |   | Node(N_LHS, [], [x]) -> LHS(convert_expression x)
104 |   | Node(N_Vars, [], vl) -> Vars(List.map convert_variable_declaration vl)
105 |   | t -> raise (Bad_tree t)
106 | and convert_variable_declaration = function
107 |   | Node(N_VariableDeclaration, [A_name, name], []) -> (name, None)
108 |   | Node(N_VariableDeclaration, [A_name, name], [x]) -> (name, Some(convert_expression x))
109 |   | t -> raise (Bad_tree t)
110 | and convert_expression = function
111 |   | Node(N_Expression, [], xl) -> Sq(List.map convert_expression xl)
112 |   | Node(N_Array, [], xl) -> Array(List.map convert_expression xl)
113 |   | Node(N_Function, [A_start, start_pos; A_name, name; A_end, end_pos], [Node(N_Args, [], al); Node(N_Body, _, sl)]) ->
114 |       Function(int_of_string start_pos, int_of_string end_pos, (Some name, List.map convert_arg al, convert_source_elements sl))
115 |   | Node(N_Function, [A_start, start_pos; A_end, end_pos], [Node(N_Args, [], al); Node(N_Body, _, sl)]) ->
116 |       Function(int_of_string start_pos, int_of_string end_pos, (None, List.map convert_arg al, convert_source_elements sl))
117 |   | Node(N_String, [A_value, v], []) -> L(String v)
118 |   | Node(N_Regexp, (A_body, body) :: options', []) as t ->
119 |       let options = match options' with
120 |         | [] -> ""
121 |         | [A_options, options] -> options
122 |         | _ -> raise (Bad_tree t)
123 |       in
124 |       L(Regexp(body, options))
125 |   | Node(N_Integer, [A_value, n], []) -> L(Int(int32_of_string n))
126 |   | Node(N_Float, [A_value, f], []) -> L(Float(float_of_string f))
127 |   | Node(N_Shift, [], [x1;Node(N_Asr, _, _);x2]) -> B(B_asr, convert_expression x1, convert_expression x2)
128 |   | Node(N_Shift, [], [x1;Node(N_Lsr, _, _);x2]) -> B(B_lsr, convert_expression x1, convert_expression x2)
129 |   | Node(N_Shift, [], [x1;Node(N_Lsl, _, _);x2]) -> B(B_lsl, convert_expression x1, convert_expression x2)
130 |   | Node(N_Add, [], [x1;x2]) -> B(B_add, convert_expression x1, convert_expression x2)
131 |   | Node(N_Sub, [], [x1;x2]) -> B(B_sub, convert_expression x1, convert_expression x2)
132 |   | Node(N_Mul, [], [x1;x2]) -> B(B_mul, convert_expression x1, convert_expression x2)
133 |   | Node(N_Div, [], [x1;x2]) -> B(B_div, convert_expression x1, convert_expression x2)
134 |   | Node(N_Mod, [], [x1;x2]) -> B(B_mod, convert_expression x1, convert_expression x2)
135 |   | Node(N_Or, [], [x1;x2]) -> B(B_or, convert_expression x1, convert_expression x2)
136 |   | Node(N_And, [], [x1;x2]) -> B(B_and, convert_expression x1, convert_expression x2)
137 |   | Node(N_BitXor, [], [x1;x2]) -> B(B_bitxor, convert_expression x1, convert_expression x2)
138 |   | Node(N_BitAnd, [], [x1;x2]) -> B(B_bitand, convert_expression x1, convert_expression x2)
139 |   | Node(N_BitOr, [], [x1;x2]) -> B(B_bitor, convert_expression x1, convert_expression x2)
140 |   | Node(N_Conditional, [], [x1;x2;x3]) -> Conditional(convert_expression x1, convert_expression x2, convert_expression x3)
141 |   | Node(N_Assign, [], [x1;op;x2]) -> Assign(convert_expression x1, convert_assignment_operator op, convert_expression x2)
142 |   | Node(N_True, [], []) -> L(Bool true)
143 |   | Node(N_False, [], []) -> L(Bool false)
144 |   | Node(N_Null, [], []) -> L Null
145 |   | Node(N_This, [], []) -> This
146 |   | Node(N_Undefined, [], []) -> L Undefined
147 |   | Node(N_BitNot, [], [x]) -> U(U_bitnot, convert_expression x)
148 |   | Node(N_Delete, [], [x]) -> U(U_delete, convert_expression x)
149 |   | Node(N_Void, [], [x]) -> U(U_void, convert_expression x)
150 |   | Node(N_TypeOf, [], [x]) -> U(U_typeof, convert_expression x)
151 |   | Node(N_Plus, [], [x]) -> U(U_plus, convert_expression x)
152 |   | Node(N_Minus, [], [x]) -> U(U_minus, convert_expression x)
153 |   | Node(N_Not, [], [x]) -> U(U_not, convert_expression x)
154 |   | Node(N_New, [], [x]) -> U(U_new, convert_expression x)
155 |   | Node(N_Increment, [], [Node(N_Pre, [], []); x]) -> U(U_pre_increment, convert_expression x)
156 |   | Node(N_Decrement, [], [Node(N_Pre, [], []); x]) -> U(U_pre_decrement, convert_expression x)
157 |   | Node(N_Increment, [], [Node(N_Post, [], []); x]) -> U(U_post_increment, convert_expression x)
158 |   | Node(N_Decrement, [], [Node(N_Post, [], []); x]) -> U(U_post_decrement, convert_expression x)
159 |   | Node(N_Equality, [], [x1; Node(op, [], []); x2]) as t->
160 |       let y1 = convert_expression x1 in
161 |       let y2 = convert_expression x2 in
162 |       B(
163 |         begin
164 |           match op with
165 |           | N_Equal -> B_equal
166 |           | N_NotEqual -> B_notequal
167 |           | N_PhysicalEqual -> B_physequal
168 |           | N_NotPhysicalEqual -> B_physnotequal
169 |           | _ -> raise (Bad_tree t)
170 |         end,
171 |         y1,
172 |         y2)
173 |   | Node(N_Compare, [], [x1; Node(rel, [], []); x2]) as t->
174 |       let y1 = convert_expression x1 in
175 |       let y2 = convert_expression x2 in
176 |       B(
177 |         begin
178 |           match rel with
179 |           | N_Le -> B_le
180 |           | N_Ge -> B_ge
181 |           | N_Lt -> B_lt
182 |           | N_Gt -> B_gt
183 |           | N_In -> B_in
184 |           | N_InstanceOf -> B_instanceof
185 |           | _ -> raise (Bad_tree t)
186 |         end,
187 |         y1,
188 |         y2)
189 |   | Node(N_Access, [], x :: rest) ->
190 |       let y = convert_expression x in
191 |       convert_access y rest
192 |   | Node(N_Var, [A_name, name], []) -> V name
193 |   | Node(N_Object, [], pl) -> Object(List.map convert_property pl)
194 |   | Node(N_DanglingComma, [A_start, start_pos; A_end, end_pos], []) -> Extra(int_of_string start_pos, int_of_string end_pos, DanglingComma)
195 |   | t -> raise (Bad_tree t)
196 | and convert_property_name = function
197 |   | Node(N_Ident, [A_name, name], []) | Node(N_String, [A_value, name], []) -> PN_String name
198 |   | Node(N_Integer, [A_value, value], []) -> PN_Int(int32_of_string value)
199 |   | Node(N_Float, [A_value, value], []) -> PN_Float(float_of_string value)
200 |   | t -> raise (Bad_tree t)
201 | and convert_property = function
202 |   | Node(N_Property, [], [pn; x]) -> (convert_property_name pn, convert_expression x)
203 |   | Node(N_DanglingComma, [A_start, start_pos; A_end, end_pos], []) -> (PN_Empty, Extra(int_of_string start_pos, int_of_string end_pos, DanglingComma))
204 |   | t -> raise (Bad_tree t)
205 | and convert_assignment_operator = function
206 |   | Node(N_Eq, [], []) -> A_eq
207 |   | Node(N_Mul, [], []) -> A_mul
208 |   | Node(N_Div, [], []) -> A_div
209 |   | Node(N_Mod, [], []) -> A_mod
210 |   | Node(N_Add, [], []) -> A_add
211 |   | Node(N_Sub, [], []) -> A_sub
212 |   | Node(N_Lsl, [], []) -> A_lsl
213 |   | Node(N_Lsr, [], []) -> A_lsr
214 |   | Node(N_Asr, [], []) -> A_asr
215 |   | Node(N_And, [], []) -> A_and
216 |   | Node(N_Xor, [], []) -> A_xor
217 |   | Node(N_Or, [], []) -> A_or
218 |   | t -> raise (Bad_tree t)
219 | and convert_access y = function
220 |   | [] -> y
221 |   | Node(N_Apply, [], args) :: rest -> convert_access (Apply(y, List.map convert_expression args)) rest
222 |   | Node(N_Bracket, [], [x]) :: rest -> convert_access (B(B_bracket, y, convert_expression x)) rest
223 |   | Node(N_Dot, [A_field, field], []) :: rest -> convert_access (B(B_bracket, y, L(String field))) rest
224 |   | ts -> raise (Bad_trees ts)
225 | ;;
226 | 


--------------------------------------------------------------------------------
/eval.ml:
--------------------------------------------------------------------------------
  1 | (* Eval *)
  2 | 
  3 | open Conduit;;
  4 | open Pffpsf;;
  5 | open Ast;;
  6 | open Source;;
  7 | exception Error of string
  8 | 
  9 | module SS = Set.Make(String);;
 10 | module SM = Map.Make(String);;
 11 | module PNM = Map.Make(struct type t = property_name let compare = compare end);;
 12 | 
 13 | type 'func t =
 14 | | T_String of string option
 15 | | T_Float of float option
 16 | | T_Int of int32 option
 17 | | T_Regexp
 18 | | T_Bool of bool option
 19 | | T_Null
 20 | | T_Undefined
 21 | | T_Object of 'func dictionary option
 22 | | T_Component of 'func t option
 23 | | T_Array of 'func t array option
 24 | | T_Function of ('func * 'func dictionary) option
 25 | | T_Variable of string
 26 | | T_Property of 'func t * property_name
 27 | | T_Unknown
 28 | and 'func dictionary = 'func t PNM.t ref
 29 | ;;
 30 | 
 31 | let max_depth = 5;;
 32 | 
 33 | let rec scribe_t ?(depth=0) cd oc x =
 34 |   if depth = max_depth then
 35 |     cd.cd_print oc ".."
 36 |   else
 37 |     match x with
 38 |     | T_String(Some u) -> cd.cd_print oc "<String %S>" u
 39 |     | T_String _ -> cd.cd_print oc "<String>"
 40 |     | T_Float _ -> cd.cd_print oc "<Float>"
 41 |     | T_Int _ -> cd.cd_print oc "<Int>"
 42 |     | T_Bool _ -> cd.cd_print oc "<Bool>"
 43 |     | T_Component(Some y) -> cd.cd_print oc "<Component %a>" (scribe_t ~depth:(depth + 1) cd) y
 44 |     | T_Component None -> cd.cd_print oc "<Component>"
 45 |     | T_Object(Some o) -> cd.cd_print oc "<Object %a>" (scribe_dictionary ~depth:(depth + 1) cd) o;
 46 |     | T_Object None -> cd.cd_print oc "<Object>"
 47 |     | T_Array _ -> cd.cd_print oc "<Array>"
 48 |     | T_Null -> cd.cd_print oc "<Null>"
 49 |     | T_Regexp -> cd.cd_print oc "<Regexp>"
 50 |     | T_Undefined -> cd.cd_print oc "<Undefined>"
 51 |     | T_Function(None) -> cd.cd_print oc "<Function>"
 52 |     | T_Function(Some((None, _, _), d)) -> cd.cd_print oc "<Function (anon) %a>" (scribe_dictionary ~depth:(depth + 1) cd) d;
 53 |     | T_Function(Some((Some n, _, _), d)) -> cd.cd_print oc "<Function %S %a>" n (scribe_dictionary ~depth:(depth + 1) cd) d;
 54 |     | T_Variable v -> cd.cd_print oc "<Var %s>" v
 55 |     | T_Property(v, pn) -> cd.cd_print oc "<Property %a.%a>" (scribe_t ~depth:(depth + 1) cd) v (scribe_property_name cd) pn
 56 |     | T_Unknown -> cd.cd_print oc "<Unknown>"
 57 | and scribe_dictionary ?(depth=0) cd oc o =
 58 |   if depth = max_depth then
 59 |     cd.cd_print oc ".."
 60 |   else
 61 |     PNM.iter
 62 |       begin fun x y ->
 63 |         cd.cd_print oc "%a: %a," (scribe_property_name  cd) x (scribe_t ~depth:(depth + 1) cd) y
 64 |       end
 65 |       !o
 66 | ;;
 67 | 
 68 | type func = name option * name list * source_element list;;
 69 | 
 70 | type env = {
 71 |   env_bindings : func dictionary option;
 72 |   env_obj : func dictionary option;
 73 |   env_start : int;
 74 |   env_end : int;
 75 |   mutable env_filename : string
 76 | };;
 77 | 
 78 | exception Result of func t;;
 79 | exception Error of string;;
 80 | exception At of int * int * exn;;
 81 | 
 82 | let create_dict () = ref PNM.empty;;
 83 | let create_object () = T_Object(Some(create_dict ()));;
 84 | let copy_dictionary d = ref !d;;
 85 | let copy_dictionary_option = function
 86 | | None -> None
 87 | | Some d -> Some(copy_dictionary d)
 88 | ;;
 89 | let copy_env env = { env with env_bindings = copy_dictionary_option env.env_bindings; env_obj = copy_dictionary_option env.env_obj };;
 90 | 
 91 | let evaluate ~warn ~warn_cd ~error ~error_cd sources =
 92 |   let env = {
 93 |     env_bindings = Some(ref PNM.empty);
 94 |     env_obj = Some(ref PNM.empty);
 95 |     env_start = 0;
 96 |     env_end = 0;
 97 |     env_filename = "*NONE*"
 98 |   }
 99 |   in
100 |   (*** set_property *)
101 |   let set_property d pn x =
102 |     warn_cd (fun cd oc -> cd.cd_print oc "Assign %a <- %a" (scribe_property_name cd) pn (scribe_t cd) x);
103 |     d := PNM.add pn x !d
104 |   in
105 |   (* ***)
106 |   (*** get_property *)
107 |   let get_property d pn =
108 |     warn_cd (fun cd oc -> cd.cd_print oc "Get %a" (scribe_property_name cd) pn);
109 |     try
110 |       PNM.find pn !d
111 |     with
112 |     | Not_found ->
113 |       match pn with
114 |       | PN_String "prototype" -> create_object ()
115 |       | _ -> T_Unknown
116 |         (*raise (Error(stringify (fun cd oc -> cd.cd_print oc "Property %a not found" (scribe_property_name cd) pn)))*)
117 |   in
118 |   (* ***)
119 |   (*** set_object_property *)
120 |   let set_object_property o pn x =
121 |     match o with
122 |     | T_Function(Some(_, d)) | T_Object(Some d) -> set_property d pn x
123 |     | T_Object None -> warn "Setting property on unknown object"
124 |     | T_Unknown -> warn "Setting property on unknown value"
125 |     | _ -> raise (Error("Attempt to set property on a non-object"))
126 |   in
127 |   (* ***)
128 |   (*** assign *)
129 |   let assign env name value =
130 |     match env.env_bindings with
131 |     | Some d -> set_property d name value
132 |     | None -> ()
133 |   in
134 |   (* ***)
135 |   (* Create default objects *)
136 |   let find env name =
137 |     match env.env_bindings with
138 |     | Some e -> PNM.find name !e
139 |     | None -> raise Not_found
140 |   in
141 |   let rec eval_source_element env = function
142 |     | St(start_pos, end_pos, s) ->
143 |         begin
144 |           try
145 |             eval_statement env s
146 |           with
147 |           | Error e as x -> raise (At(start_pos, end_pos, x))
148 |         end
149 |     | FunDecl(start_pos, end_pos, (None, _, _)) -> raise (At(start_pos, end_pos, (Error("Anonymous function declaration"))))
150 |     | FunDecl(start_pos, end_pos, (Some name, args, body)) -> assign env (PN_String name) (T_Function(Some((Some name, args, body), create_dict ())))
151 |   and check_numerics l =
152 |     match List.fold_left unify T_Unknown l with
153 |     | (T_Int _|T_Float _) as t -> t
154 |     | _ -> raise (Error(sf "Not a number"))
155 |   and eval_statement_option env = function
156 |     | None -> ()
157 |     | Some s -> eval_statement env s
158 |   and unify y1 y2 =
159 |     if y1 = y2 then
160 |       y1
161 |     else
162 |       match y1, y2 with
163 |       | T_String _, T_String _ -> T_String None
164 |       | (T_Float _, (T_Float _|T_Int _)) | (T_Int _, T_Float _) -> T_Float None
165 |       | T_Int _, T_Int _ -> T_Int None
166 |       | T_Bool _, T_Bool _ -> T_Bool None
167 |       | T_Null, T_Null -> T_Null
168 |       | _, T_Undefined|T_Undefined, _ -> T_Undefined
169 |       | T_Unknown, x|x, T_Unknown -> x
170 |       | _, _ -> T_Unknown
171 |   and eval_expr_as_lhs env = function
172 |     | V name -> T_Variable name
173 |     | B(B_bracket, x1, x2) ->
174 |       let y1 = eval_expr env x1 in
175 |       let y2 = eval_expr env x2 in
176 |       begin
177 |         match y2 with
178 |         | T_String(Some u) -> T_Property(y1, PN_String u)
179 |         | _ -> T_Unknown
180 |       end
181 |     | _ -> T_Unknown
182 |   and eval_expr (env : env) = function
183 |     | Extra _ -> T_Undefined
184 |     | Apply(B (B_bracket, V "Class", L (String "create")), xl) ->
185 |       create_object ()
186 |     | Apply(B (B_bracket, V "Component", L (String "create")), xl) ->
187 |       begin
188 |         warn (sf "Found Component.create, %d args" (List.length xl));
189 |         (*let y = eval_expr env x in
190 |         T_Component(Some y)*)
191 |         T_Component None
192 |       end
193 |     | Apply(x, xl) ->
194 |       let y = eval_expr env x in
195 |       begin
196 |         match y with
197 |         | T_Function None -> T_Unknown
198 |         | T_Function(Some((no, nl, bd),d)) ->
199 |           let xll = List.length xl
200 |           and nll = List.length nl
201 |           in
202 |           if xll = nll then
203 |             begin
204 |               let env' = copy_env env in
205 |               List.iter2
206 |                 begin fun n x ->
207 |                   let y = eval_expr env x in
208 |                   assign env' (PN_String n) y
209 |                 end
210 |                 nl
211 |                 xl;
212 |               try
213 |                 List.iter (eval_source_element env') bd;
214 |                 T_Undefined
215 |               with
216 |               | Result t -> t
217 |             end
218 |           else
219 |             T_Unknown (* raise (Error (sf "Wrong number of arguments, expected %d, got %d" nll xll)) *)
220 |         | _ -> T_Unknown
221 |         (*x -> raise (Error(stringify (fun cd oc -> cd.cd_print oc "Not a function (%a)" (scribe_t cd) x)))*)
222 |       end
223 |     | Assign(x1, op, x2) ->
224 |       begin match op with
225 |         | A_eq ->
226 |           let y1 = eval_expr_as_lhs env x1 in
227 |           let y2 = eval_expr env x2 in
228 |           begin
229 |             match y1 with
230 |             | T_Variable v -> assign env (PN_String v) y2
231 |             | T_Property(y, pn) ->
232 |               warn (stringify (fun cd oc -> cd.cd_print oc "Setting property %a" (scribe_property_name cd) pn));
233 |               set_object_property y pn y2
234 |             | _ -> warn "Unresolved assignment"
235 |           end;
236 |           y2
237 |         | _ -> T_Int None
238 |       end
239 |     | Sq xl ->
240 |       let rec loop = function
241 |       | [x] -> eval_expr env x
242 |       | [] -> T_Undefined
243 |       | x :: rest -> ignore (eval_expr env x); loop rest
244 |       in
245 |       loop xl
246 |     | L(Float f) -> T_Float(Some f)
247 |     | L(Int x) -> T_Int(Some x)
248 |     | L(String u) -> T_String(Some u)
249 |     | L(Regexp _) -> T_Regexp
250 |     | L(Bool b) -> T_Bool(Some b)
251 |     | L Null -> T_Null
252 |     | L Undefined -> T_Undefined
253 |     | Conditional(x1, x2, x3) ->
254 |         ignore (eval_expr env x1);
255 |         unify (eval_expr env x2) (eval_expr env x3)
256 |     | V name ->
257 |       begin
258 |         try
259 |           find env (PN_String name)
260 |         with
261 |         | Not_found ->
262 |             warn (sf "Can't find variable %s" name);
263 |             T_Unknown
264 |       end
265 |     | U(op, x) ->
266 |       begin
267 |         let y = eval_expr env x in
268 |         match op,y with
269 |         | (U_pre_increment | U_pre_decrement | U_post_increment | U_post_decrement | U_plus | U_minus | U_bitnot), _ -> check_numerics [y]
270 |         | U_not, T_Bool(Some b) -> T_Bool(Some(not b))
271 |         | U_not, T_Null -> T_Bool(Some true)
272 |         | U_not, _ -> T_Bool None
273 |         | U_delete, _ -> T_Null (* XXX *)
274 |         | _, _ -> T_Unknown
275 |       end
276 |     | B(op, x1, x2) ->
277 |       begin
278 |         let y1 = eval_expr env x1
279 |         and y2 = eval_expr env x2
280 |         in
281 |         match op,y1,y2 with
282 |         | (B_mul | B_div | B_mod | B_sub | B_bitand | B_bitor | B_bitxor), _, _ -> check_numerics [y1]
283 |         | (B_and | B_or | B_le | B_ge | B_lt | B_gt | B_equal | B_notequal | B_physequal | B_physnotequal | B_instanceof), _, _ -> T_Bool None
284 |         | B_bracket, T_Object(Some d), T_String(Some u) ->
285 |               get_property d (PN_String u)
286 |         | _, _, _ -> T_Unknown
287 |       end
288 |     | This -> T_Object(env.env_obj)
289 |     | Array xl -> T_Array(Some(Array.of_list (List.map (eval_expr env) xl)))
290 |     | Object pl ->
291 |       let dict = create_dict () in
292 |       List.iter
293 |         begin fun (pn, x) ->
294 |           let y = eval_expr env x in
295 |           set_property dict pn y
296 |         end
297 |         pl;
298 |       T_Object(Some dict)
299 |     | Function(_, _, (no, al, sl)) -> T_Function(Some( (no, al, sl), create_dict () ))
300 |   and eval_statement : env -> st -> unit = fun env st -> match st with
301 |     | Position(start_pos, end_pos, s) ->
302 |         begin
303 |           try
304 |             eval_statement env s
305 |           with
306 |           | Error e as x -> raise (At(start_pos, end_pos, x))
307 |         end
308 |     | Expr x -> ignore (eval_expr env x)
309 |     | If(x, s, so) ->
310 |         let _ = eval_expr env x in
311 |         eval_statement env s;
312 |         eval_statement_option env so
313 |     | Do(s, x) ->
314 |         eval_statement env s;
315 |         ignore (eval_expr env x)
316 |     | While(x, s) ->
317 |         ignore (eval_expr env x);
318 |         eval_statement env s
319 |     | For(so1, so2, so3, s) ->
320 |         eval_statement_option env so1;
321 |         eval_statement_option env so2;
322 |         eval_statement_option env so3;
323 |         eval_statement env s
324 |     | Continue _ -> () (* XXX Check labels *)
325 |     | Break _ -> () (* XXX Check labels *)
326 |     | Return None -> ()
327 |     | Return(Some x) -> ignore (eval_expr env x)
328 |     | With(This, s) ->
329 |         let env' = { env with env_bindings = env.env_obj }  in
330 |         eval_statement env' s
331 |     | With(x, s) ->
332 |         () (* XXX *)
333 |     | Variable vl -> List.iter (eval_variable_declaration env) vl
334 |     | _ -> ()
335 |   and eval_variable_declaration env (name, xo) =
336 |     let y =
337 |       match xo with
338 |       | None -> T_Undefined
339 |       | Some x -> eval_expr env x
340 |     in
341 |     assign env (PN_String name) y
342 |   in
343 |   List.iter
344 |     begin fun s ->
345 |       env.env_filename <- s.s_file;
346 |       try
347 |         List.iter (eval_source_element env) s.s_source
348 |       with
349 |       | At(start_pos, end_pos, Error e) ->
350 |         error_cd (fun cd oc -> cd.cd_print oc "Error in file %S at %a: %s" s.s_file (scribe_position s.s_liner cd) (start_pos, end_pos) e)
351 |     end
352 |     sources
353 | ;;
354 | 


--------------------------------------------------------------------------------
/process.ml:
--------------------------------------------------------------------------------
  1 | (* Process *)
  2 | 
  3 | open Conduit;;
  4 | open Pffpsf;;
  5 | open Ast;;
  6 | open Source;;
  7 | exception Error of string
  8 | 
  9 | (*** result *)
 10 | type result = {
 11 |   mutable res_errors : string list;
 12 |   mutable res_warnings : string list
 13 | };;
 14 | (* ***)
 15 | (*** read_channel *)
 16 | let read_channel ic =
 17 |   let fd = Unix.descr_of_in_channel ic in
 18 |   let st = Unix.fstat fd in
 19 |   if st.Unix.st_kind = Unix.S_REG then
 20 |     begin
 21 |       let m = in_channel_length ic in
 22 |       let u = String.create m in
 23 |       really_input ic u 0 m;
 24 |       u
 25 |     end
 26 |   else
 27 |     begin
 28 |       let u = String.create 4096 in
 29 |       let b = Buffer.create 4096 in
 30 |       let rec loop () =
 31 |         let n = input ic u 0 (String.length u) in
 32 |         if n = 0 then
 33 |           Buffer.contents b
 34 |         else
 35 |           begin
 36 |             Buffer.add_substring b u 0 n;
 37 |             loop ()
 38 |           end
 39 |       in
 40 |       loop ()
 41 |     end
 42 | ;;
 43 | (* ***)
 44 | (*** name_of_source *)
 45 | let name_of_source = function
 46 |   | `Stdin -> "*stdin*"
 47 |   | `File fn -> fn
 48 | ;;
 49 | (* ***)
 50 | (*** read_source *)
 51 | let read_source = function
 52 |   | `Stdin -> read_channel stdin
 53 |   | `File fn ->
 54 |       let ic = open_in fn in
 55 |       let u = read_channel ic in
 56 |       close_in ic;
 57 |       u
 58 | ;;
 59 | (* ***)
 60 | module SS = Set.Make(String);;
 61 | module SM = Map.Make(String);;
 62 | 
 63 | module PNS = Set.Make(struct type t = property_name let compare = compare end);;
 64 | module PNM = Map.Make(struct type t = property_name let compare = compare end);;
 65 | 
 66 | exception Exit;;
 67 | 
 68 | let position_of_info info = (info.i_start, info.i_end);;
 69 | 
 70 | let load_ast fn =
 71 |   let ic = open_in_bin fn in
 72 |   let t : program = Marshal.from_channel ic in
 73 |   close_in ic;
 74 |   t
 75 | ;;
 76 | 
 77 | (*** load_strings_from_file *)
 78 | let load_strings_from_file fn =
 79 |   let ic = open_in fn in
 80 |   let set = ref SS.empty in
 81 |   try
 82 |     while true do
 83 |       let u = input_line ic in
 84 |       set := SS.add u !set
 85 |     done;
 86 |     assert false
 87 |   with
 88 |   | End_of_file ->
 89 |       close_in ic;
 90 |       !set
 91 | ;;
 92 | (* ***)
 93 | (*** is_prefix *)
 94 | let is_prefix u v =
 95 |   let m = String.length u
 96 |   and n = String.length v
 97 |   in
 98 |   m <= n &&
 99 |     let rec loop i = i = m or u.[i] = v.[i] && loop (i + 1) in
100 |     loop 0
101 | ;;
102 | (* ***)
103 | (*** need_to_warnify *)
104 | let need_to_warnify fn = List.exists (fun prefix -> is_prefix prefix fn) !Opt.warnify;;
105 | (* ***)
106 | (*** need_to_ignorify *)
107 | let need_to_ignorify fn = List.exists (fun prefix -> is_prefix prefix fn) !Opt.ignorify;;
108 | (* ***)
109 | (*** filename_rex *)
110 | let filename_rex = lazy (Str.regexp !Opt.filename_regexp);;
111 | (* ***)
112 | (*** sources *)
113 | let sources oc sl =
114 |   let cd = stdoutcd in
115 |   (* Check that all source files have a valid extension *)
116 |   let result = { res_errors = []; res_warnings = [] } in
117 |   let error u = result.res_errors <- u :: result.res_errors in
118 |   let info u = if not !Opt.quiet then fp oc "%sINFO: %s%s\n%!" (Ansi.foreground !Opt.info_color) u (Ansi.none ()) in
119 |   let warn u = result.res_warnings <- u :: result.res_warnings in
120 |   let ignore_cd f = () in
121 |   (*** error_cd *)
122 |   let error_cd f =
123 |     let b = Buffer.create 128 in
124 |     let cd = conduit_of_buffer b in
125 |     f cd cd.cd_out_channel;
126 |     error (Buffer.contents b)
127 |   in
128 |   (* ***)
129 |   (*** warn_cd *)
130 |   let warn_cd f = warn (stringify f)
131 |   in
132 |   (* ***)
133 |   (*** error_or_warn_cd *)
134 |   let error_or_warn_cd fn =
135 |     if need_to_ignorify fn then
136 |       ignore_cd
137 |     else
138 |       if need_to_warnify fn then
139 |         warn_cd
140 |       else
141 |         error_cd
142 |   in
143 |   (* ***)
144 |   (*** info_cd *)
145 |   let info_cd f = info (stringify f) in
146 |   (* ***)
147 |   let warn u = result.res_warnings <- u :: result.res_warnings in
148 |   let have_errors () = result.res_errors <> [] in
149 |   let exit_on_error () = if have_errors () then raise Exit in
150 |   (*** check_extensions *)
151 |   let check_extensions () =
152 |     List.iter
153 |       (fun fn ->
154 |         if not (Str.string_match (Lazy.force filename_rex) fn 0) then
155 |           error (sf "Filename %S does not conform to regexp %S." fn !Opt.filename_regexp))
156 |       sl
157 |   in
158 |   (* ***)
159 |   (*** compute_props *)
160 |   let compute_props pg =
161 |     let props = ref PNM.empty in
162 |     (*** property *)
163 |     let property info u =
164 |       let set =
165 |         try
166 |          PNM.find u !props
167 |         with
168 |         | Not_found -> PS.empty
169 |       in
170 |       props := PNM.add u (PS.add (position_of_info info) set) !props
171 |     in
172 |     (* ***)
173 |     (*** walk_expression *)
174 |     let rec walk_expression assign info = function
175 |       | Assign(x1, _, x2) -> walk_expression true info x1; walk_expression assign info x2
176 |       | Sq xl -> List.iter (walk_expression assign info) xl
177 |       | Function(_, _, (_, _, sl)) -> Ast.iter_over_expr_in_program info (walk_expression assign) sl
178 |       | L _|V _|Extra _ -> ()
179 |       | U(_, x) -> walk_expression assign info x
180 |       | B(binop, x1, x2) ->
181 |           walk_expression assign info x1;
182 |           walk_expression assign info x2;
183 |           begin
184 |             match binop with
185 |             | B_bracket ->
186 |                 begin
187 |                   match x2 with
188 |                   | L(String u) -> if assign (*or true*) then property info (PN_String u)
189 |                   | _ -> ()
190 |                 end
191 |             | _ -> ()
192 |           end
193 |        | Object pl ->
194 |            List.iter
195 |              begin fun (u, x) ->
196 |                (*property u;*)
197 |                walk_expression assign info x
198 |              end
199 |              pl
200 |        | Array xl -> List.iter (walk_expression assign info) xl
201 |        | Apply(x, xl) -> walk_expression assign info x; List.iter (walk_expression assign info) xl
202 |        | Conditional(x1,x2,x3) ->
203 |            walk_expression assign info x1;
204 |            walk_expression assign info x2;
205 |            walk_expression assign info x3
206 |        | This -> ()
207 |     in
208 |     (* ***)
209 |     Ast.iter_over_expr_in_program Ast.info0 (walk_expression false) pg;
210 |     !props
211 |   in
212 |   (* ***)
213 |   (*** list_props *)
214 |   let list_props liner props =
215 |     PNM.iter
216 |       begin fun pn set ->
217 |         stdoutcd.cd_print stdoutcd.cd_out_channel "  %a : %a\n" (scribe_property_name cd) pn (scribe_position_set liner cd) set
218 |       end
219 |       props
220 |   in
221 |   (* ***)
222 |   (*** minefield *)
223 |   let minefield =
224 |     match !Opt.minefield with
225 |     | None -> None
226 |     | Some fn ->
227 |       Some
228 |         begin
229 |           let mf = Minefield.create () in
230 |           let set = 
231 |             info (sf "Loading minefield from %S" fn);
232 |             load_strings_from_file fn
233 |           in
234 |           SS.iter (fun u -> Minefield.add_word mf (String.lowercase u)) set;
235 |           mf
236 |         end
237 |   in
238 |   (* ***)
239 |   (*** is_property_forbidden *)
240 |   let is_property_forbidden =
241 |     match !Opt.forbidden_props_file with
242 |     | None -> fun _ -> false
243 |     | Some fn ->
244 |         let set =
245 |           info (sf "Loading forbidden properties from %S" fn);
246 |           load_strings_from_file fn
247 |         in
248 |         fun u -> SS.mem u set
249 |   in
250 |   (* ***)
251 |   (*** is_misspelling *)
252 |   let is_misspelling =
253 |     match minefield with
254 |     | None -> fun _ -> None
255 |     | Some mf -> fun u ->
256 |       let u = String.lowercase u in
257 |       let m = !Opt.mine_distance *. log (float (String.length u)) /. log 2.0 in
258 |       match Minefield.check_proximity mf u with
259 |       | None -> None
260 |       | Some(d,v) as x ->
261 |         if d < m then
262 |           x
263 |         else
264 |           None
265 |   in
266 |   (* ***)
267 |   (*** check_forbidden_props *)
268 |   let check_forbidden_props fn liner props =
269 |     let report = error_or_warn_cd fn in
270 |     PNM.iter
271 |       begin fun pn set ->
272 |         match pn with
273 |         | PN_String u ->
274 |             begin
275 |               match is_misspelling u with
276 |               | None -> ()
277 |               | Some(d,v) ->
278 |                 warn_cd (fun cd oc -> 
279 |                    cd.cd_print oc "Property %a is possible misspelling of %S (d=%f), used in file %S at %a"
280 |                      (scribe_property_name cd) pn
281 |                      v
282 |                      d
283 |                      fn
284 |                      (scribe_position_set liner cd) set)
285 |             end;
286 |             if is_property_forbidden u then
287 |               report (fun cd oc -> 
288 |                  cd.cd_print oc "Forbidden property %a used in file %S at %a"
289 |                    (scribe_property_name cd) pn
290 |                    fn
291 |                    (scribe_position_set liner cd) set)
292 |         | _ -> ()
293 |       end
294 |       props
295 |   in
296 |   (* ***)
297 |   let sources = ref [] in
298 |   (*** check_file *)
299 |   let cache = match !Opt.cache with
300 |     | None -> None
301 |     | Some fn -> Some(Cache.create ~version:Ast.version fn)
302 |   in
303 |   let check_source src =
304 |     info "Loading";
305 |     let fn = name_of_source src in
306 |     let u = read_source src in
307 |     let liner = Liner.create ~offset:!Opt.line_number_offset u in
308 |     try
309 |       (*** reparse *)
310 |       let reparse () =
311 |         info "Parsing";
312 |         let t = Ecma.parse u in
313 |         (*** !Opt.dump_ast *)
314 |         if !Opt.dump_ast then
315 |           begin
316 |             let fn' = (Filename.chop_extension fn)^".xml" in
317 |             info (sf "Dumping AST into file %S" fn');
318 |             let oc = open_out fn' in
319 |             Ecma.print_tree oc t;
320 |             close_out oc
321 |           end;
322 |         (* ***)
323 |         t
324 |       in
325 |       (* ***)
326 |       (*** t *)
327 |       let t =
328 |         match cache with
329 |         | None -> reparse ()
330 |         | Some c ->
331 |           try
332 |             let t = Cache.get c fn u in
333 |             info (sf "Cached parse tree for %S" fn);
334 |             t
335 |           with
336 |           | Not_found ->
337 |             let t = reparse () in
338 |             Cache.set c fn u t;
339 |             t
340 |       in
341 |       (* ***)
342 |       if !Opt.just_syntax then
343 |         info (sf "File %S has valid syntax" fn)
344 |       else
345 |         begin
346 |           (*** pg *)
347 |           let pg =
348 |             begin
349 |               info "Converting AST";
350 |               try
351 |                 let pg = Convert.convert t in
352 |                 info "AST OK";
353 |                 (*** !Opt.dump_raw_ast *)
354 |                 if !Opt.dump_raw_ast then
355 |                   begin
356 |                     let fn' = (Filename.chop_extension fn)^".bin" in
357 |                     info (sf "Dumping raw AST into file %S" fn');
358 |                     let oc = open_out_bin fn' in
359 |                     Marshal.to_channel oc pg [];
360 |                     close_out oc
361 |                   end;
362 |                 (* ***)
363 |                 pg
364 |               with
365 |               | (Convert.Bad_tree t) as x -> pf "Bad tree:\n%a\n" Ecma.print_tree t; raise x
366 |               | (Convert.Bad_trees ts) as x ->
367 |                   pf "Bad trees:\n";
368 |                   List.iter (fun t -> Ecma.print_tree stdout t) ts;
369 |                   raise x
370 |             end
371 |           in
372 |           (* ***)
373 |           let source = { s_file = fn;
374 |                          s_text = u;
375 |                          s_source = pg;
376 |                          s_liner = liner;
377 |                          s_warnify = need_to_warnify fn;
378 |                          s_ignorify = need_to_ignorify fn }
379 |           in
380 |           sources := source :: !sources;
381 |           let properties = compute_props pg in
382 |           if !Opt.list_props then
383 |             begin
384 |               fp oc "Properties in file %S:\n" fn;
385 |               list_props liner properties;
386 |               fp oc "End of properties in file %S.\n%!" fn
387 |             end;
388 |           check_forbidden_props fn liner properties;
389 |           if !Opt.generate then
390 |             begin
391 |               info "Generating";
392 |               let fn' = (Filename.chop_extension fn)^".gen.js" in
393 |               let oc = open_out fn' in
394 |               let f = Format.formatter_of_out_channel oc in
395 |               Generate.generate f pg;
396 |               Format.fprintf f "@."
397 |             end;
398 |         end
399 |     with
400 |     | Aurochs_pack.Aurochs.Parse_error x ->
401 |         error_cd
402 |           (fun cd oc ->
403 |             cd.cd_print
404 |             oc
405 |             "In file %S, parse error at %a:\n%s"
406 |             fn
407 |             (scribe_position liner cd)
408 |             (x, x + 1)
409 |             (Excerpt.excerpt liner u x (x + 1)))
410 |     | x -> 
411 |         if !Opt.dont_catch then
412 |           raise x
413 |         else
414 |           error (sf "In file %S, unlocated parse error %s." fn (Printexc.to_string x))
415 |   in
416 |   (* ***)
417 |   (*** close_cache *)
418 |   let close_cache () =
419 |     match cache with
420 |     | None -> ()
421 |     | Some c -> Cache.close c
422 |   in
423 |   (* ***)
424 |   try
425 |     check_extensions ();
426 |     let sl = List.map (fun fn -> `File fn) sl in
427 |     let sl =
428 |       if !Opt.read_from_stdin then
429 |         `Stdin :: sl
430 |       else
431 |         sl
432 |     in
433 |     exit_on_error ();
434 |     List.iter (fun src ->
435 |       let fn = name_of_source src in
436 |       info (sf "Processing file %S" fn);
437 |       check_source src;
438 |       info (sf "Done with file %S" fn)) sl;
439 |     if !Opt.typecheck then
440 |       begin
441 |         info "Typechecking";
442 |         Eval.evaluate ~warn ~warn_cd ~error ~error_cd !sources
443 |       end;
444 |     if !Opt.check then
445 |       begin
446 |         info "Checking";
447 |         Check.check ~dump_cd:cd ~info_cd ~warn ~warn_cd ~error ~error_cd !sources
448 |       end;
449 |     { res_errors = List.rev result.res_errors; res_warnings = List.rev result.res_warnings }
450 |   with
451 |   | x ->
452 |     close_cache ();
453 |     match x with
454 |     | Exit -> result
455 |     | _ -> raise x
456 | ;;
457 | (* ***)
458 | 


--------------------------------------------------------------------------------
/check.ml:
--------------------------------------------------------------------------------
  1 | (* Check *)
  2 | 
  3 | open Conduit;;
  4 | open Pffpsf;;
  5 | open Ast;;
  6 | open Source;;
  7 | exception Error of string
  8 | 
  9 | module SS = Set.Make(String);;
 10 | module SM = Map.Make(String);;
 11 | module PNM = Map.Make(struct type t = property_name let compare = compare end);;
 12 | 
 13 | let max_depth = 5;;
 14 | 
 15 | type t =
 16 |   | T_Function
 17 |   | T_Variable
 18 |   | T_Argument
 19 |   | T_Undefined
 20 | ;;
 21 | 
 22 | type value = {
 23 |   mutable v_value : t;
 24 |   v_level : int;
 25 |   mutable v_usage : int;
 26 |   v_start : int;
 27 |   v_end : int;
 28 |   mutable v_warned_unused : bool;
 29 | }
 30 | 
 31 | type scope =
 32 |   | S_Toplevel
 33 |   | S_Function of string option
 34 | ;;
 35 | 
 36 | type 'a dictionary = 'a SM.t ref;;
 37 | 
 38 | type env = {
 39 |   env_bindings : value dictionary option;
 40 |   env_with : bool;
 41 |   env_obj : value dictionary option;
 42 |   env_start : int;
 43 |   env_end : int;
 44 |   env_scope : scope;
 45 |   env_level : int;
 46 |   mutable env_source : Source.source option
 47 | };;
 48 | 
 49 | exception Error of string;;
 50 | exception At of int * int * exn;;
 51 | 
 52 | let create_dict () = ref SM.empty;;
 53 | let copy_dictionary d = ref !d;;
 54 | let copy_dictionary_option = function
 55 | | None -> None
 56 | | Some d -> Some(copy_dictionary d)
 57 | ;;
 58 | (*** is_supposedly_unused *)
 59 | let is_supposedly_unused =
 60 |   let rex = lazy (Str.regexp !Opt.unused_ident_regexp) in
 61 |   fun n -> Str.string_match (Lazy.force rex) n 0
 62 | ;;
 63 | (* ***)
 64 | (*** rex_options_rx *)
 65 | let rex_options_rx1 = Str.regexp "^[giwm]*$";;
 66 | let rex_options_rx2 = Str.regexp "^.*\\(g.*g\\|i.*i\\|m.*m\\).*$";;
 67 | (* ***)
 68 | (*** copy_env *)
 69 | let copy_env env = {
 70 |   env with
 71 |   env_bindings = copy_dictionary_option env.env_bindings;
 72 |   env_obj = copy_dictionary_option env.env_obj;
 73 |   env_level = env.env_level + 1
 74 | };;
 75 | (* ***)
 76 | (*** check *)
 77 | let check ~dump_cd ~info_cd ~warn ~warn_cd ~error ~error_cd sources =
 78 |   let cd = dump_cd in
 79 | 
 80 |   let oc = cd.cd_out_channel in
 81 |   let print = cd.cd_print in
 82 |   let env = {
 83 |     env_bindings = Some(create_dict ());
 84 |     env_obj = Some(create_dict ());
 85 |     env_start = 0;
 86 |     env_end = 0;
 87 |     env_with = false;
 88 |     env_source = None;
 89 |     env_scope = S_Toplevel;
 90 |     env_level = 0
 91 |   }
 92 |   in
 93 |   let informer v f env x =
 94 |     f begin fun cd oc ->
 95 |         match env.env_source with
 96 |         | None -> cd.cd_print oc "In *UNKNOWN LOCATION*: %s" x
 97 |         | Some s ->
 98 |             match v with
 99 |             | Pos -> cd.cd_print oc "In file %S at %a: %s" s.s_file (scribe_position s.s_liner cd) (env.env_start, env.env_end) x
100 |             | Txt ->
101 |                 (* Show source... *)
102 |                 cd.cd_print
103 |                   oc
104 |                   "In file %S at %a: %s:\n%s"
105 |                   s.s_file
106 |                   (scribe_position s.s_liner cd)
107 |                   (env.env_start, env.env_end)
108 |                   x
109 |                   (Excerpt.excerpt s.s_liner s.s_text env.env_start env.env_end)
110 |       end
111 |   in
112 |   let warn env x =
113 |     match env.env_source with
114 |     | None -> informer !Opt.warning_visualization error_cd env x
115 |     | Some s ->
116 |       if s.s_ignorify then
117 |         ()
118 |       else
119 |         informer !Opt.warning_visualization warn_cd env x
120 |   and error env x =
121 |     match env.env_source with
122 |     | None -> informer !Opt.error_visualization error_cd env x
123 |     | Some s ->
124 |       if s.s_ignorify then
125 |         ()
126 |       else
127 |         if s.s_warnify then
128 |           informer !Opt.warning_visualization warn_cd env x
129 |         else
130 |           informer !Opt.error_visualization error_cd env x
131 |   in
132 |   (* Create default objects *)
133 |   (*** dump_env *)
134 |   let dump_env env = 
135 |     cd.cd_print oc "{ with=%b %d--%d level=%d \n" env.env_with env.env_start env.env_end env.env_level;
136 |     begin
137 |       match env.env_bindings with
138 |       | None -> cd.cd_print oc "  (no bindings)\n"
139 |       | Some d ->
140 |         SM.iter
141 |           begin fun n v ->
142 |             cd.cd_print oc "    %s : %s, level=%d usage=%d\n"
143 |               n
144 |               (match v.v_value with T_Function -> "fun" | T_Argument -> "arg" | T_Variable -> "var" | T_Undefined -> "und")
145 |               v.v_level
146 |               v.v_usage
147 |           end
148 |           !d
149 |     end;
150 |     cd.cd_print oc "}\n";
151 |   in
152 |   (* ***)
153 |   (*** treatment *)
154 |   let treatment var env u =
155 |     match !var with
156 |     | Ign -> ()
157 |     | Wrn -> warn env u
158 |     | Err -> error env u
159 |   in
160 |   (* ***)
161 |   (*** find *)
162 |   let find env name =
163 |     match env.env_bindings with
164 |     | Some e -> SM.find name !e
165 |     | None -> raise Not_found
166 |   in
167 |   (* ***)
168 |   (*** assign *)
169 |   let assign env name value =
170 |     if !Opt.dump_env then
171 |       begin
172 |         print oc "Assigning %s in environment:\n" name;
173 |         dump_env env
174 |       end;
175 |     match env.env_bindings with
176 |     | Some d ->
177 |         d := SM.add name
178 |               { v_value = value;
179 |                 v_usage = 0;
180 |                 v_level = env.env_level;
181 |                 v_start = env.env_start;
182 |                 v_end = env.env_end;
183 |                 v_warned_unused = false } !d
184 |     | None -> ()
185 |   in
186 |   (* ***)
187 |   (*** finish_env *)
188 |   let finish_env env =
189 |     match env.env_bindings with
190 |     | None -> ()
191 |     | Some d ->
192 |         SM.iter
193 |           begin fun n v ->
194 |             if v.v_level = env.env_level && v.v_usage = 0 && not (is_supposedly_unused n) && not v.v_warned_unused then
195 |               begin
196 |                 v.v_warned_unused <- true;
197 |                 let env = { env with env_start = v.v_start; env_end = v.v_end } in
198 |                 match v.v_value with
199 |                 | T_Argument -> treatment Opt.unused_args env (sf "Unused argument %S" n)
200 |                 | T_Undefined | T_Variable -> treatment Opt.unused_vars env (sf "Unused identifier %S" n)
201 |                 | T_Function -> treatment Opt.unused_funs env (sf "Unused function %S" n)
202 |               end
203 |           end
204 |           !d
205 |   in
206 |   (* ***)
207 |   let rec check_source_element env = function
208 |     | St(start_pos, end_pos, s) ->
209 |         let env' = { env with env_start = start_pos; env_end = end_pos } in
210 |         check_statement ~toplevel:true env' s
211 |     | FunDecl(start_pos, end_pos, func) ->
212 |         let env' = { env with env_start = start_pos; env_end = end_pos } in
213 |         begin
214 |           match func with
215 |           | (Some name, _, _) ->
216 |               assign env' name T_Function;
217 |               check_function env' func
218 |           | (None, _, _) -> error env "Anonymous function declaration"
219 |         end
220 |   and check_function env (no, al, sl) =
221 |     let env' = copy_env env in
222 |     List.iter
223 |       begin fun n ->
224 |         assign env' n T_Argument;
225 |       end
226 |       al;
227 |     List.iter (check_source_element env') sl;
228 |     finish_env env'
229 |   and check_statement_option env = function
230 |     | None -> ()
231 |     | Some s -> check_statement env s
232 |   and check_expr_as_lhs ?(toplevel=false) env = function
233 |     | V name ->
234 |         begin
235 |           try
236 |             if is_supposedly_unused name then treatment Opt.using_unused env (sf "Supposedly unused identifier %S assigned to" name);
237 |             let v = find env name in
238 |             v.v_usage <- v.v_usage + 1;
239 |             match v.v_value with
240 |             | T_Function -> ()
241 |             | T_Variable -> ()
242 |             | T_Argument -> treatment Opt.assigning_to_args env (sf "Assigning to argument %S" name)
243 |             | T_Undefined -> v.v_value <- T_Variable
244 |           with
245 |           | Not_found ->
246 |               (* See if this is a top-level assignment *)
247 |               if toplevel then
248 |                 treatment Opt.toplevel_bindings env (sf "Toplevel binding to %S" name)
249 |               else
250 |                 if env.env_with then
251 |                   ()
252 |                 else
253 |                   treatment Opt.unbound_variables env (sf "Unbound variable %s" name)
254 |         end
255 |     | B(B_bracket, x1, x2) ->
256 |       check_expr env x1;
257 |       check_expr env x2;
258 |       begin
259 |         match x2 with
260 |           | L(String _u) -> ()
261 |           | _ -> ()
262 |       end
263 |     | _ -> warn env "Possibly invalid LHS"
264 |   and check_expr ?(toplevel=false) (env : env) = function
265 |     | Extra(start_pos, end_pos, DanglingComma) -> treatment Opt.dangling_commas { env with env_start = start_pos; env_end = end_pos } "Dangling comma"
266 |     | Apply(x, xl) ->
267 |       check_expr env x;
268 |       List.iter (check_expr env) xl
269 |     | Assign(x1, _, x2) ->
270 |       check_expr_as_lhs ~toplevel env x1;
271 |       check_expr env x2;
272 |     | Sq xl -> List.iter (check_expr env) xl
273 |     | L(Regexp(x, o)) ->
274 |         begin
275 |           try
276 |             ignore (Ecmarex.parse x);
277 |             if not (Str.string_match rex_options_rx1 o 0)
278 |                or  (Str.string_match rex_options_rx2 o 0) then
279 |               treatment Opt.bad_regexps env (sf "Bad regular expression options %S" o)
280 |           with
281 |           | Aurochs_pack.Aurochs.Parse_error n ->
282 |               let msg =
283 |                 if n = 0 then
284 |                   sf "%S  <-wtf?" x
285 |                 else
286 |                   if n = String.length x then
287 |                     sf "wtf?->  %S" x
288 |                   else
289 |                     sf "%S  <-wtf?->  %S" (String.sub x 0 n) (String.sub x n (String.length x - n))
290 |               in
291 |               treatment Opt.bad_regexps env (sf "Invalid regular expression: %s" msg)
292 |         end
293 |     | L(Float _) | L(Int _) | L(String _) | L(Bool _) | L Null | L Undefined  -> ()
294 |     | Conditional(x1, x2, x3) ->
295 |         check_expr env x1;
296 |         check_expr env x2;
297 |         check_expr env x3
298 |     | V name ->
299 |       begin
300 |         try
301 |           if is_supposedly_unused name then treatment Opt.using_unused env (sf "Supposedly unused identifier %S used" name);
302 |           let v = find env name in
303 |           v.v_usage <- 1 + v.v_usage;
304 |           match v.v_value with
305 |           | T_Undefined -> treatment Opt.uninitialized_vars env (sf "Variable %S may be used while undefined" name)
306 |           | _ -> ()
307 |         with
308 |         | Not_found -> 
309 |             treatment Opt.undefined_variables env (sf "Variable %s could be undefined" name)
310 |       end
311 |     | U(_, x) -> check_expr env x
312 |     | B(_, x1, x2) ->
313 |       begin
314 |         check_expr env x1;
315 |         check_expr env x2
316 |       end
317 |     | This -> ()
318 |     | Array xl -> List.iter (check_expr env) xl
319 |     | Object pl -> List.iter (fun (_, x) -> check_expr env x) pl
320 |     | Function(start_pos, end_pos, func) -> check_function { env with env_start = start_pos; env_end = end_pos } func
321 |   and check_statement ?(toplevel=false) env st =
322 |     if !Opt.dump_env then
323 |       begin
324 |         print oc "Statement in environment:\n";
325 |         dump_env env
326 |       end;
327 |     match st with
328 |     | Position(start_pos, end_pos, s) ->
329 |         let env' = { env with env_start = start_pos; env_end = end_pos } in
330 |         check_statement ~toplevel env' s
331 |     | Expr x -> check_expr ~toplevel env x
332 |     | If(x, s, so) ->
333 |         check_expr env x;
334 |         check_statement env s;
335 |         check_statement_option env so
336 |     | Do(s, x) ->
337 |         check_statement env s;
338 |         check_expr env x
339 |     | While(x, s) ->
340 |         check_expr env x;
341 |         check_statement env s
342 |     | For(so1, so2, so3, s) ->
343 |         check_statement_option env so1;
344 |         check_statement_option env so2;
345 |         check_statement_option env so3;
346 |         check_statement env s
347 |     | ForIn(lv, x, st) ->
348 |         let env' = copy_env env in
349 |         check_lhs_or_var ~forin:true env' lv;
350 |         check_expr env' x;
351 |         check_statement env' st
352 |     | Throw x -> check_expr env x
353 |     | Continue _ -> () (* XXX Check labels *)
354 |     | Break _ -> () (* XXX Check labels *)
355 |     | Labeled _ -> ()
356 |     | Return None -> ()
357 |     | Return(Some x) -> ignore (check_expr env x)
358 |     | With(x, s) ->
359 |         check_expr env x;
360 |         let env' = copy_env env in
361 |         let env' = { env' with env_with = true }  in
362 |         check_statement env' s;
363 |         finish_env env'
364 |     | Variable vl -> List.iter (check_variable_declaration env) vl
365 |     | Block sl ->
366 |       let env' = copy_env env in
367 |       List.iter (check_statement env') sl;
368 |       finish_env env'
369 |     | Nop -> ()
370 |     | Try(s, catch, so) ->
371 |         check_statement env s;
372 |         begin
373 |           match catch with
374 |           | None -> ()
375 |           | Some(n, s) ->
376 |             let env' = copy_env env in
377 |             assign env' n T_Argument;
378 |             check_statement env' s;
379 |             finish_env env'
380 |         end;
381 |         begin
382 |           match so with
383 |           | None -> ()
384 |           | Some s -> check_statement env s
385 |         end
386 |      | Switch(x, cl) ->
387 |        check_expr env x;
388 |        List.iter
389 |          begin fun (cl, s) ->
390 |            List.iter
391 |              begin function
392 |              | Default -> ()
393 |              | Case x -> check_expr env x
394 |              end
395 |              cl;
396 |            check_statement env s
397 |          end
398 |          cl
399 |   and check_lhs_or_var ?(forin=false) env = function
400 |   | LHS x -> check_expr_as_lhs env x
401 |   | Vars vl -> List.iter (check_variable_declaration ~forin env) vl
402 |   and check_variable_declaration ?(forin=false) env (name, xo) =
403 |     begin
404 |       try
405 |         let v = find env name in
406 |         match v.v_value with
407 |         | T_Argument -> treatment Opt.shadowing_args env (sf "Variable %s shadows argument of the same name" name)
408 |         | _ -> ()
409 |       with
410 |       | Not_found -> ()
411 |     end;
412 |     assign env name
413 |       begin match xo with
414 |         | None ->
415 |           if forin then
416 |             T_Variable
417 |           else
418 |             T_Undefined
419 |         | Some x -> check_expr env x; T_Variable
420 |       end
421 |   in
422 |   List.iter
423 |     begin fun s ->
424 |       env.env_source <- Some s;
425 |       try
426 |         List.iter (check_source_element env) s.s_source
427 |       with
428 |       | At(start_pos, end_pos, Error e) ->
429 |         error_cd (fun cd oc -> cd.cd_print oc "Error in file %S at %a: %s" s.s_file (scribe_position s.s_liner cd) (start_pos, end_pos) e)
430 |     end
431 |     sources
432 | ;;
433 | (* ***)
434 | 


--------------------------------------------------------------------------------
/ecma.peg:
--------------------------------------------------------------------------------
  1 | (* Ecmascript grammar *)
  2 | 
  3 | space ::=
  4 |    [ \n\r\t]
  5 |  | "<!--"
  6 |  | "//" [^\r\n]* ([\r\n]|EOF)
  7 |  | "/*" ((~ "*/") sigma)* "*/"
  8 | ;
  9 | 
 10 | integer ::=
 11 |     value:(
 12 |       '-'?
 13 |         (
 14 |             "0x" [0-9a-fA-F]+
 15 |           | '0' [0-7]+
 16 |           | [1-9][0-9]*
 17 |           | '0'
 18 |         )
 19 |       )
 20 |       &
 21 |       sp
 22 |   ;
 23 | 
 24 | float ::=
 25 |     value:(
 26 |       '-'?
 27 |       (([0-9]* '.' [0-9]+) | ([0-9]+ ('.' [0-9]*)?))
 28 |       ([eE] ('+'|'-')? [0-9] [0-9]*)?
 29 |     )
 30 |     &
 31 |     sp
 32 |   ;
 33 | 
 34 | alphanum ::= [A-Za-z_0-9$]; (* Check lexical rules for identifiers *)
 35 | alpha ::= [A-Za-z_$];
 36 | 
 37 | quote_string_escape ::= '\\' [bfnrtv'\\];
 38 | quote_string ::= ('\'' value:(((~ '\'') (quote_string_escape | [^'])))* '\'');
 39 | 
 40 | double_quote_string_escape ::= '\\' [bfnrtv"\\];
 41 | double_quote_string ::= ('"' value:(((~ '"') (double_quote_string_escape | [^"])))* '"');
 42 | 
 43 | string ::= quote_string | double_quote_string;
 44 | 
 45 | regexp ::= (~ ("//"|"/*")) '/'body:(regexp_inner*)'/'(options:regexp_option+)? ~[a-zA-Z0-9_];
 46 | 
 47 | regexp_option ::= [giwm];
 48 | regexp_escape ::= '\\' [bfnrtv/\\];
 49 | regexp_inner ::= ((~ '/') (regexp_escape | [^/\n]));
 50 | 
 51 | sp ::= space+ | ~alpha | BOF;
 52 | 
 53 | LBRACE ::= "{";
 54 | RBRACE ::= "}";
 55 | LPAR ::= "(";
 56 | RPAR ::= ")";
 57 | LBRACK ::= "[";
 58 | RBRACK ::= "]";
 59 | DOT ::= ".";
 60 | DOTCOM ::= ";";
 61 | COMMA ::= ",";
 62 | L ::= "<";
 63 | R ::= ">";
 64 | LEQ ::= "<=";
 65 | REQ ::= ">=";
 66 | EQEQ ::= "==";
 67 | NOTEQ ::= "!=";
 68 | EQEQEQ ::= "===";
 69 | NOTEQEQ ::= "!==";
 70 | PLUS ::= "+";
 71 | MINUS ::= "-";
 72 | TIMES ::= "*";
 73 | MOD ::= "%";
 74 | PLUSPLUS ::= "++";
 75 | MINUSMINUS ::= "--";
 76 | LL ::= "<<";
 77 | RR ::= ">>";
 78 | RRR ::= ">>>";
 79 | AND ::= "&";
 80 | OR ::= "|";
 81 | HAT ::= "^";
 82 | BANG ::= "!";
 83 | TILDE ::= "~";
 84 | ANDAND ::= "&&";
 85 | OROR ::= "||";
 86 | QUESTION ::= "?";
 87 | DOTDOT ::= ":";
 88 | EQ ::= "=";
 89 | PLUSEQ ::= "+=";
 90 | MINUSEQ ::= "-=";
 91 | TIMESEQ ::= "*=";
 92 | MODEQ ::= "%=";
 93 | LLEQ ::= "<<=";
 94 | RREQ ::= ">>=";
 95 | RRREQ ::= ">>>=";
 96 | ANDEQ ::= "&=";
 97 | OREQ ::= "|=";
 98 | HATEQ ::= "^=";
 99 | DIV ::= "/";
100 | DIVEQ ::= "/=";
101 | 
102 | suffixing sp do
103 |   ABSTRACT ::= "abstract";
104 |   BOOLEAN ::= "boolean";
105 |   BREAK ::= "break";
106 |   BYTE ::= "byte";
107 |   CASE ::= "case";
108 |   CATCH ::= "catch";
109 |   CHAR ::= "char";
110 |   CLASS ::= "class";
111 |   CONST ::= "const";
112 |   CONTINUE ::= "continue";
113 |   DEBUGGER ::= "debugger";
114 |   DEFAULT ::= "default";
115 |   DELETE ::= "delete";
116 |   DO ::= "do";
117 |   DOUBLE ::= "double";
118 |   ELSE ::= "else";
119 |   ENUM ::= "enum";
120 |   EXPORT ::= "export";
121 |   EXTENDS ::= "extends";
122 |   FALSE ::= "false";
123 |   FINAL ::= "final";
124 |   FINALLY ::= "finally";
125 |   FLOAT ::= "float";
126 |   FOR ::= "for";
127 |   FUNCTION ::= "function";
128 |   GOTO ::= "goto";
129 |   IF ::= "if";
130 |   IMPLEMENTS ::= "implements";
131 |   IMPORT ::= "import";
132 |   IN ::= "in";
133 |   INSTANCEOF ::= "instanceof";
134 |   INTERFACE ::= "interface";
135 |   INT ::= "int";
136 |   LONG ::= "long";
137 |   NATIVE ::= "native";
138 |   NEW ::= "new";
139 |   NULL ::= "null";
140 |   PACKAGE ::= "package";
141 |   PRIVATE ::= "private";
142 |   PROTECTED ::= "protected";
143 |   PUBLIC ::= "public";
144 |   RETURN ::= "return";
145 |   SHORT ::= "short";
146 |   STATIC ::= "static";
147 |   SUPER ::= "super";
148 |   SWITCH ::= "switch";
149 |   SYNCHRONIZED ::= "synchronized";
150 |   THIS ::= "this";
151 |   THROWS ::= "throws";
152 |   THROW ::= "throw";
153 |   TRANSIENT ::= "transient";
154 |   TRUE ::= "true";
155 |   TRY ::= "try";
156 |   TYPEOF ::= "typeof";
157 |   UNDEFINED ::= "undefined";
158 |   VAR ::= "var";
159 |   VOID ::= "void";
160 |   VOLATILE ::= "volatile";
161 |   WHILE ::= "while";
162 |   WITH ::= "with";
163 | done;
164 | 
165 | keyword ::=
166 |   "abstract"
167 | | "break"
168 | | "boolean"
169 | | "byte"
170 | | "case"
171 | | "catch"
172 | | "char"
173 | | "class"
174 | | "const"
175 | | "continue"
176 | | "debugger"
177 | | "default"
178 | | "delete"
179 | | "do"
180 | | "double"
181 | | "else"
182 | | "enum"
183 | | "export"
184 | | "extends"
185 | | "false"
186 | | "final"
187 | | "finally"
188 | | "float"
189 | | "for"
190 | | "function"
191 | | "goto"
192 | | "if"
193 | | "implements"
194 | | "import"
195 | | "in"
196 | | "instanceof"
197 | | "int"
198 | | "interface"
199 | | "long"
200 | | "native"
201 | | "new"
202 | | "null"
203 | | "package"
204 | | "private"
205 | | "protected"
206 | | "public"
207 | | "return"
208 | | "short"
209 | | "static"
210 | | "super"
211 | | "switch"
212 | | "synchronized"
213 | | "this"
214 | | "throw"
215 | | "throws"
216 | | "transient"
217 | | "true"
218 | | "try"
219 | | "typeof"
220 | | "undefined"
221 | | "var"
222 | | "void"
223 | | "volatile"
224 | | "while"
225 | | "with"
226 | ;
227 | 
228 | IDENTIFIER ::= ~(keyword sp) alpha alphanum*;
229 | 
230 | optional_space ::= space*;
231 | 
232 | outfixing optional_space do
233 |   appending optional_space do
234 |     program ::= <Program> source_elements </Program>;
235 |     source_elements ::= source_element*;
236 |     source_element ::= function_declaration | <St>start:position statement end:position</St> DOTCOM?;
237 | 
238 |     statement ::= <Position>start:position inner_statement end:position</Position>;
239 | 
240 |     inner_statement ::=
241 |       block
242 |     | labeled_statement
243 |     | variable_statement
244 |     | expression_statement
245 |     | if_statement
246 |     | iteration_statement
247 |     | continue_statement
248 |     | break_statement
249 |     | return_statement
250 |     | with_statement
251 |     | switch_statement
252 |     | throw_statement
253 |     | try_statement
254 |     | empty_statement
255 |     ;
256 | 
257 |     block ::=
258 |       LBRACE <Block>statement_list</Block> RBRACE
259 |     | LBRACE <Block/> RBRACE
260 |     ;
261 | 
262 |     statement_list ::= statement (DOTCOM? statement)* DOTCOM?;
263 | 
264 |     variable_statement ::= VAR <VariableStatement> variable_declaration_list </VariableStatement>;
265 | 
266 |     variable_declaration_list ::= variable_declaration (COMMA variable_declaration_list)*;
267 | 
268 |     variable_declaration ::=
269 |         <VariableDeclaration> name:IDENTIFIER initializer </VariableDeclaration>
270 |       | <VariableDeclaration> name:IDENTIFIER </VariableDeclaration>
271 |       ;
272 | 
273 |     initializer ::= EQ assignment_expression;
274 | 
275 |     empty_statement ::= <EmptyStatement/>;
276 | 
277 |     expression_statement ::= <ExpressionStatement>expression</ExpressionStatement>;
278 | 
279 |     if_statement ::=
280 |         <If>IF LPAR <Condition>expression</Condition> RPAR <True>statement DOTCOM?</True> ELSE <False>statement</False></If>
281 |       | <If>IF LPAR <Condition>expression</Condition> RPAR <True>statement DOTCOM?</True> </If>
282 |       ;
283 | 
284 |     iteration_statement ::=
285 |         <Do> DO <Loop>statement DOTCOM?</Loop> WHILE LPAR <Condition>expression</Condition> RPAR </Do>
286 |       | <While> WHILE LPAR <Condition>expression</Condition> RPAR <Loop>statement</Loop> </While>
287 |       | <ForIn>
288 |           FOR
289 |             LPAR
290 |               <Index>
291 |                 (<LHS>left_hand_side_expression</LHS> | VAR <Vars>variable_declaration_list</Vars>)
292 |               </Index>
293 |               IN
294 |               <Container>expression</Container>
295 |             RPAR
296 |             <Loop>statement</Loop>
297 |           </ForIn>
298 |       | <For> FOR LPAR
299 |                 (<Start>statement</Start>)? DOTCOM
300 |                 (<Condition>statement</Condition>)? DOTCOM
301 |                 (<Next>statement</Next>)? RPAR
302 |               <Loop>statement</Loop>
303 |         </For>
304 |       ;
305 | 
306 |     continue_statement ::=
307 |         CONTINUE <Continue> label:IDENTIFIER </Continue>
308 |       | CONTINUE <Continue/>
309 |       ;
310 | 
311 |     break_statement ::=
312 |         BREAK <Break>label:IDENTIFIER</Break>
313 |       | BREAK <Break/>
314 |       ;
315 | 
316 |     return_statement ::=
317 |         <Return>RETURN expression </Return>
318 |       | RETURN <Return/>
319 |       ;
320 | 
321 |     with_statement ::=
322 |         <With>WITH LPAR expression RPAR <Body>statement</Body></With>
323 |        ;
324 | 
325 |     switch_statement ::=
326 |         <Switch>SWITCH LPAR expression RPAR LBRACE case* RBRACE</Switch>
327 |       ;
328 | 
329 |     case ::=
330 |         <Case><Clauses>case_clause+</Clauses><Body>statement_list</Body></Case>
331 |        ;
332 | 
333 |     case_clause ::=
334 |         <Default/> DEFAULT DOTDOT
335 |       | <When>CASE expression DOTDOT</When>
336 |       ;
337 | 
338 |     labeled_statement ::= <Label>name:IDENTIFIER DOTDOT <Body>statement</Body></Label>;
339 | 
340 |     throw_statement ::= <Throw>THROW expression</Throw>;
341 | 
342 |     try_statement ::=
343 |         <Try>TRY <Block>block</Block> (<Catch>catch</Catch>)? <Finally>FINALLY block</Finally></Try>
344 |       | <Try>TRY <Block>block</Block> <Catch>catch</Catch></Try>
345 |       ;
346 | 
347 |     catch ::= CATCH LPAR <Arg>name:IDENTIFIER</Arg> RPAR <Body>block</Body>;
348 | 
349 |     numeric_litteral ::=
350 |       <Float>float</Float>
351 |     | <Integer>integer</Integer>
352 |     ;
353 | 
354 |     litteral ::=
355 |       numeric_litteral
356 |     | <String>string</String>
357 |     | <Regexp>regexp</Regexp>
358 |     | <True/>TRUE
359 |     | <False/>FALSE
360 |     | <Null/>NULL
361 |     | <Undefined/>UNDEFINED
362 |     ;
363 | 
364 |     primary_expression ::=
365 |         <This/> THIS
366 |       | <Var>name:IDENTIFIER</Var>
367 |       | object_litteral
368 |       | array_litteral
369 |       | LPAR expression RPAR
370 |       | litteral
371 |       ;
372 | 
373 |     array_litteral ::=
374 |         <Array> LBRACK element_list dangling_comma? RBRACK </Array>
375 |       | <Array> LBRACK dangling_comma? RBRACK </Array>
376 |       | <Array/> LBRACK RBRACK
377 |       ;
378 | 
379 |     dangling_comma ::= <DanglingComma>start:position COMMA+ end:position</DanglingComma>;
380 | 
381 |     elision ::= COMMA+;
382 | 
383 |     element_list ::=
384 |         assignment_expression COMMA elision? element_list
385 |       | elision? assignment_expression
386 |       ;
387 | 
388 |     object_litteral ::=
389 |       <Object>LBRACE (property_name_and_value (COMMA property_name_and_value)*)? dangling_comma? RBRACE</Object>;
390 | 
391 |     property_name_and_value ::= <Property>property_name DOTDOT assignment_expression</Property>;
392 | 
393 |     property_name ::=
394 |         <Ident>name:IDENTIFIER</Ident>
395 |       | <String>string</String>
396 |       | numeric_litteral
397 |       ;
398 | 
399 |     member_final ::=
400 |         <New><Access>NEW member_expression <Apply>arguments</Apply></Access></New>
401 |       | function_expression
402 |       | primary_expression
403 |       ;
404 | 
405 |     member_expression ::=
406 |         <Access>member_final member_rest+</Access>
407 |       | <New>NEW member_expression</New> (* XXX *)
408 |       | member_final
409 |       ;
410 | 
411 |     new_expression ::=
412 |         <New>NEW new_expression</New>
413 |       | access_expression
414 |       ;
415 | 
416 |     access_expression ::=
417 |         <Access>member_final (call_rest | member_rest) +</Access>
418 |       | member_final
419 |       ;
420 | 
421 |     call_rest ::= <Apply>arguments</Apply>;
422 | 
423 |     member_rest ::=
424 |         <Bracket>LBRACK expression RBRACK</Bracket>
425 |       | <Dot>DOT field:IDENTIFIER</Dot>
426 |       ;
427 | 
428 | 
429 |     arguments ::=
430 |         LPAR argument (COMMA argument)* RPAR
431 |       | LPAR RPAR
432 |       ;
433 | 
434 |     argument ::= assignment_expression; (* Arg *)
435 | 
436 |     left_hand_side_expression ::=
437 |         access_expression
438 |       | new_expression
439 |       ;
440 | 
441 |     postfix_expression ::=
442 |         <Increment><Post/>left_hand_side_expression PLUSPLUS</Increment>
443 |       | <Decrement><Post/>left_hand_side_expression MINUSMINUS</Decrement>
444 |       | left_hand_side_expression
445 |       ;
446 | 
447 |     unary_expression ::=
448 |         <Delete>DELETE unary_expression</Delete>
449 |       | <Void>VOID unary_expression</Void>
450 |       | <TypeOf>TYPEOF unary_expression</TypeOf>
451 |       | <Increment><Pre/>PLUSPLUS unary_expression</Increment>
452 |       | <Decrement><Pre/>MINUSMINUS unary_expression</Decrement>
453 |       | <Plus>PLUS unary_expression</Plus>
454 |       | <Minus>MINUS unary_expression</Minus>
455 |       | <BitNot>TILDE unary_expression</BitNot>
456 |       | <Not>BANG unary_expression</Not>
457 |       | postfix_expression
458 |       ;
459 | 
460 |     multiplicative_expression ::=
461 |         <Mul>unary_expression TIMES multiplicative_expression</Mul>
462 |       | <Div>unary_expression DIV multiplicative_expression</Div>
463 |       | <Mod>unary_expression MOD multiplicative_expression</Mod>
464 |       | unary_expression
465 |       ;
466 | 
467 |     additive_expression ::=
468 |         <Add>multiplicative_expression PLUS additive_expression</Add>
469 |       | <Sub>multiplicative_expression MINUS additive_expression</Sub>
470 |       | multiplicative_expression
471 |       ;
472 | 
473 |     shift_expression ::=
474 |         <Shift>additive_expression shift_op additive_expression</Shift>
475 |       | additive_expression
476 |       ;
477 | 
478 |     shift_op ::=
479 |         <Lsr/>RRR
480 |       | <Lsl/>LL
481 |       | <Asr/>RR
482 |       ;
483 | 
484 |     relational_expression ::=
485 |         <Compare>shift_expression relation relational_expression</Compare>
486 |       | shift_expression
487 |       ;
488 | 
489 |     relation ::=
490 |         <Le/>LEQ
491 |       | <Ge/>REQ
492 |       | <Lt/>L
493 |       | <Gt/>R
494 |       | <InstanceOf/>INSTANCEOF
495 |       | <In/>IN
496 |       ;
497 | 
498 |     equality_expression ::=
499 |         <Equality>relational_expression equality_operator equality_expression</Equality>
500 |       | relational_expression
501 |       ;
502 | 
503 |     equality_operator ::=
504 |         <PhysicalEqual/>EQEQEQ
505 |       | <NotPhysicalEqual/>NOTEQEQ
506 |       | <Equal/>EQEQ
507 |       | <NotEqual/>NOTEQ
508 |       ;
509 | 
510 |     bitwise_and_expression ::=
511 |         <BitAnd>equality_expression AND bitwise_and_expression</BitAnd>
512 |       | equality_expression
513 |       ;
514 | 
515 |     bitwise_xor_expression ::=
516 |         <BitXor>bitwise_and_expression HAT bitwise_xor_expression</BitXor>
517 |       | bitwise_and_expression
518 |       ;
519 | 
520 |     bitwise_or_expression ::=
521 |         <BitOr>bitwise_xor_expression OR bitwise_or_expression</BitOr>
522 |       | bitwise_xor_expression
523 |       ;
524 | 
525 |     logical_and_expresssion ::=
526 |         <And> bitwise_or_expression ANDAND logical_and_expresssion </And>
527 |       | bitwise_or_expression
528 |       ;
529 | 
530 |     logical_or_expression ::=
531 |         <Or> logical_and_expresssion OROR logical_or_expression </Or>
532 |       | logical_and_expresssion
533 |       ;
534 | 
535 |     conditional_expression ::=
536 |         <Conditional> logical_or_expression QUESTION assignment_expression DOTDOT assignment_expression </Conditional>
537 |       | logical_or_expression
538 |       ;
539 | 
540 |     assignment_expression ::=
541 |         <Assign>left_hand_side_expression assignment_operator assignment_expression</Assign>
542 |       | conditional_expression
543 |       ;
544 | 
545 |     assignment_operator ::=
546 |         <Eq/> EQ
547 |       | <Mul/> TIMESEQ
548 |       | <Div/> DIVEQ
549 |       | <Mod/> MODEQ
550 |       | <Add/> PLUSEQ
551 |       | <Sub/> MINUSEQ
552 |       | <Lsl/> LLEQ
553 |       | <Asr/> RREQ
554 |       | <Lsr/> RRREQ
555 |       | <And/> ANDEQ
556 |       | <Xor/> HATEQ
557 |       | <Or/> OREQ
558 |       ;
559 | 
560 |     expression ::=
561 |         <Expression>assignment_expression COMMA expression</Expression>
562 |       | assignment_expression
563 |       ;
564 | 
565 |     expression_no_in ::= expression;
566 |     variable_declaration_no_in ::= variable_declaration;
567 | 
568 |     function_expression ::=
569 |         <Function>start:position FUNCTION (name:IDENTIFIER)? LPAR <Args>formal_parameter_list?</Args> RPAR LBRACE <Body>function_body</Body> RBRACE end:position</Function>
570 |       ;
571 | 
572 |     function_declaration ::=
573 |         <FunDecl>start:position FUNCTION name:IDENTIFIER LPAR <Args>formal_parameter_list?</Args> RPAR LBRACE <Body>function_body</Body> RBRACE end:position</FunDecl>
574 |       ;
575 | 
576 |     function_body ::= source_elements;
577 | 
578 |     arg ::= <Arg>name:IDENTIFIER</Arg>;
579 | 
580 |     formal_parameter_list ::= arg (COMMA arg)*;
581 |         
582 |   done;
583 | done;
584 | 
585 | start ::= program space* EOF;
586 | 


--------------------------------------------------------------------------------