diff -Nru js-of-ocaml-1.4/benchmarks/lib/common.ml js-of-ocaml-2.2/benchmarks/lib/common.ml
--- js-of-ocaml-1.4/benchmarks/lib/common.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/lib/common.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,183 @@
+(* Js_of_ocaml benchmarks
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2011 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let (>>) x f = f x
+
+(****)
+
+let mean a =
+ let s = ref 0. in
+ for i = 0 to Array.length a - 1 do
+ s := !s +. a.(i)
+ done;
+ !s /. float (Array.length a)
+
+let mean_variance a =
+ let m = mean a in
+ let s = ref 0. in
+ for i = 0 to Array.length a - 1 do
+ let d = a.(i) -. m in
+ s := !s +. d *. d
+ done;
+ (m, !s /. float (Array.length a - 1))
+
+ (*90% 95% 98% 99% 99.5% 99.8% 99.9%*)
+let tinv_table =
+ [|(1, [|6.314; 12.71; 31.82; 63.66; 127.3; 318.3; 636.6|]);
+ (2, [|2.920; 4.303; 6.965; 9.925; 14.09; 22.33; 31.60|]);
+ (3, [|2.353; 3.182; 4.541; 5.841; 7.453; 10.21; 12.92|]);
+ (4, [|2.132; 2.776; 3.747; 4.604; 5.598; 7.173; 8.610|]);
+ (5, [|2.015; 2.571; 3.365; 4.032; 4.773; 5.893; 6.869|]);
+ (6, [|1.943; 2.447; 3.143; 3.707; 4.317; 5.208; 5.959|]);
+ (7, [|1.895; 2.365; 2.998; 3.499; 4.029; 4.785; 5.408|]);
+ (8, [|1.860; 2.306; 2.896; 3.355; 3.833; 4.501; 5.041|]);
+ (9, [|1.833; 2.262; 2.821; 3.250; 3.690; 4.297; 4.781|]);
+ (10, [|1.812; 2.228; 2.764; 3.169; 3.581; 4.144; 4.587|]);
+ (11, [|1.796; 2.201; 2.718; 3.106; 3.497; 4.025; 4.437|]);
+ (12, [|1.782; 2.179; 2.681; 3.055; 3.428; 3.930; 4.318|]);
+ (13, [|1.771; 2.160; 2.650; 3.012; 3.372; 3.852; 4.221|]);
+ (14, [|1.761; 2.145; 2.624; 2.977; 3.326; 3.787; 4.140|]);
+ (15, [|1.753; 2.131; 2.602; 2.947; 3.286; 3.733; 4.073|]);
+ (16, [|1.746; 2.120; 2.583; 2.921; 3.252; 3.686; 4.015|]);
+ (17, [|1.740; 2.110; 2.567; 2.898; 3.222; 3.646; 3.965|]);
+ (18, [|1.734; 2.101; 2.552; 2.878; 3.197; 3.610; 3.922|]);
+ (19, [|1.729; 2.093; 2.539; 2.861; 3.174; 3.579; 3.883|]);
+ (20, [|1.725; 2.086; 2.528; 2.845; 3.153; 3.552; 3.850|]);
+ (21, [|1.721; 2.080; 2.518; 2.831; 3.135; 3.527; 3.819|]);
+ (22, [|1.717; 2.074; 2.508; 2.819; 3.119; 3.505; 3.792|]);
+ (23, [|1.714; 2.069; 2.500; 2.807; 3.104; 3.485; 3.767|]);
+ (24, [|1.711; 2.064; 2.492; 2.797; 3.091; 3.467; 3.745|]);
+ (25, [|1.708; 2.060; 2.485; 2.787; 3.078; 3.450; 3.725|]);
+ (26, [|1.706; 2.056; 2.479; 2.779; 3.067; 3.435; 3.707|]);
+ (27, [|1.703; 2.052; 2.473; 2.771; 3.057; 3.421; 3.690|]);
+ (28, [|1.701; 2.048; 2.467; 2.763; 3.047; 3.408; 3.674|]);
+ (29, [|1.699; 2.045; 2.462; 2.756; 3.038; 3.396; 3.659|]);
+ (30, [|1.697; 2.042; 2.457; 2.750; 3.030; 3.385; 3.646|]);
+ (40, [|1.684; 2.021; 2.423; 2.704; 2.971; 3.307; 3.551|]);
+ (50, [|1.676; 2.009; 2.403; 2.678; 2.937; 3.261; 3.496|]);
+ (60, [|1.671; 2.000; 2.390; 2.660; 2.915; 3.232; 3.460|]);
+ (80, [|1.664; 1.990; 2.374; 2.639; 2.887; 3.195; 3.416|]);
+ (100, [|1.660; 1.984; 2.364; 2.626; 2.871; 3.174; 3.390|]);
+ (120, [|1.658; 1.980; 2.358; 2.617; 2.860; 3.160; 3.373|])|]
+
+let tinv_row n =
+ let i = ref 1 in
+ let l = Array.length tinv_table in
+ while !i < l && fst tinv_table.(!i) <= n do incr i done;
+ snd tinv_table.(!i - 1)
+
+let tinv95 n = (tinv_row n).(1)
+let tinv99 n = (tinv_row n).(3)
+
+let mean_with_confidence a =
+ let (m, v) = mean_variance a in
+ let l = Array.length a in
+ (m, sqrt v /. sqrt (float l) *. tinv99 (l - 1))
+
+(****)
+
+let src = "sources"
+let code = "build"
+let times = Filename.concat "results/times" (Unix.gethostname ())
+let sizes = "results/sizes"
+let compiletimes = Filename.concat "results/compiletimes" (Unix.gethostname ())
+
+let ml = ("ml", ".ml")
+let js = ("js", ".js")
+let byte = ("byte", "")
+let opt = ("opt", "")
+let js_of_ocaml = ("js_of_ocaml", ".js")
+let ocamljs = ("ocamljs", ".js")
+let byte_unsafe = ("unsafe/byte", "")
+let opt_unsafe = ("unsafe/opt", "")
+let js_of_ocaml_unsafe = ("unsafe/js_of_ocaml", ".js")
+let js_of_ocaml_inline = ("noinline", ".js")
+let js_of_ocaml_deadcode = ("nodeadcode", ".js")
+let js_of_ocaml_compact = ("notcompact", ".js")
+let js_of_ocaml_call = ("nooptcall", ".js")
+let ocamljs_unsafe = ("unsafe/ocamljs", ".js")
+
+(****)
+
+let no_ext (dir, _) = (dir, "")
+let file dir1 (dir2, ext) nm = Format.sprintf "%s/%s/%s%s" dir1 dir2 nm ext
+let dir dir1 (dir2, ext) = Format.sprintf "%s/%s" dir1 dir2
+let sub_spec (dir, ext) loc = (Format.sprintf "%s/%s" dir loc, ext)
+
+(****)
+
+let rec mkdir d =
+ if not (Sys.file_exists d) then begin
+ mkdir (Filename.dirname d);
+ Unix.mkdir d 0o777
+ end
+
+let need_update src dst =
+ try
+ let d = Unix.stat dst in
+ d.Unix.st_kind <> Unix.S_REG
+ ||
+ let s = Unix.stat src in
+ d.Unix.st_mtime < s.Unix.st_mtime
+ with Unix.Unix_error (Unix.ENOENT, _, _) ->
+ true
+
+(****)
+
+let measures_need_update code meas spec nm =
+ let p = file code spec nm in
+ let m = file meas (no_ext spec) nm in
+ need_update p m
+
+let read_measures meas spec nm =
+ let m = file meas (no_ext spec) nm in
+ let l = ref [] in
+ if Sys.file_exists m then begin
+ let ch = open_in m in
+ begin try
+ while true do
+ l := float_of_string (input_line ch) :: !l
+ done
+ with End_of_file -> () end;
+ close_in ch;
+ !l
+ end else
+ []
+
+let write_measures meas spec nm l =
+ let m = file meas (no_ext spec) nm in
+ let tmp = file meas (no_ext spec) "_tmp_" in
+ mkdir (dir meas spec);
+ let ch = open_out tmp in
+ List.iter (fun t -> Printf.fprintf ch "%f\n" t) (List.rev l);
+ close_out ch;
+ Sys.rename tmp m
+
+(****)
+
+let benchs loc ((_, ext) as spec) =
+ let dir = dir loc spec in
+ Sys.readdir dir >>
+ Array.to_list >>
+ List.filter (fun nm -> let k = (Unix.stat (dir^"/"^nm)).Unix.st_kind in
+ k = Unix.S_REG || k = Unix.S_LNK) >>
+ List.filter (fun nm -> ext = "" || Filename.check_suffix nm ext) >>
+ (if ext = "" then fun x -> x else List.map Filename.chop_extension) >>
+ List.sort compare
diff -Nru js-of-ocaml-1.4/benchmarks/lib/remove_comments.pl js-of-ocaml-2.2/benchmarks/lib/remove_comments.pl
--- js-of-ocaml-1.4/benchmarks/lib/remove_comments.pl 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/lib/remove_comments.pl 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+$/ = undef;
+$_ = <>;
+s#\(\*[^*]*\*+([^)*][^*]*\*+)*\)#defined $2 ? $2 : ""#gse;
+print;
diff -Nru js-of-ocaml-1.4/benchmarks/Makefile js-of-ocaml-2.2/benchmarks/Makefile
--- js-of-ocaml-1.4/benchmarks/Makefile 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/Makefile 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,202 @@
+# graphs without precompiled programs:
+GRAPHSNOPR = time.pdf time-optim.pdf time-ocamljs.pdf nativejs.pdf
+
+# graphs with precompiled programs:
+GRAPHSPR = size.pdf size-ocamljs.pdf size-optim.pdf compiletime.pdf
+
+# For full benchs:
+all: _perf graphsnopr graphspr _noperf
+
+graphsnopr: _noprecomp $(GRAPHSNOPR)
+
+graphspr: __precomp $(GRAPHSPR)
+
+# For fast benchs:
+test: _perf fastrun $(GRAPHS) _noperf
+
+exes= $(wildcard programs/*)
+
+exesnames = $(exes:programs/%=%)
+
+missingsizesml = $(exesnames:%=results/sizes/ml/%)
+missingsizesocamljs = $(exesnames:%=results/sizes/ocamljs/%)
+missingsizes=$(missingsizesml) $(missingsizesocamljs)
+
+missingcompiletimes = $(exesnames:%=results/compiletimes/`hostname`/byte/%) $(exesnames:%=results/compiletimes/`hostname`/opt/%)
+possiblymissingbenchs = results/times/`hostname`/nitro/js_of_ocaml/kb results/times/`hostname`/tm/js_of_ocaml/hamming results/times/`hostname`/tm/js_of_ocaml/splay
+
+OCAML=ocaml unix.cma
+RUN=$(OCAML) ./run.ml
+REPORT=$(OCAML) ./report.ml
+
+.PHONY: $(GRAPHSNOPR:.pdf=.svg) $(GRAPHSPR:.pdf=.svg) size.gpl _noprecomp
+
+# compile with precompiled programs for creating benchs
+__precomp:
+ mkdir -p build/byte
+ ln -sf $(exes:%=../../%) build/byte
+ if [ ! -d precomptmp ] ; then $(RUN) -compile ; else cd precomptmp ; find . -type f -exec mv {} ../{} \; ; fi
+ rm -rf precomptmp
+ touch __precomp
+
+# for running the test we do not want precompiled programs
+__run:
+ make _noprecomp
+ $(RUN) -all
+ make __possiblymissingbenchs
+ touch __run
+
+fastrun:
+ make _noprecomp
+ echo "======================== WARNING: fast benchs!"
+ $(RUN) -ffast -all
+ make __possiblymissingbenchs
+ touch __run
+
+_noprecomp:
+ if [ -f __precomp ] ; \
+ then \
+ rm -f __precomp ;\
+ mkdir -p precomptmp/build/byte ;\
+ mkdir -p build ;\
+ mkdir -p results ;\
+ find build -type d -exec mkdir -p precomptmp/{} \; ;\
+ find results -type d -exec mkdir -p precomptmp/{} \; ;\
+ for i in $(exesnames) ; do if [ -f build/byte/$$i ] ; then mv -f build/byte/$$i precomptmp/build/byte/ ; fi ; done ;\
+ for i in $(exesnames) ; do for j in build/*/$$i.js ; do if [ -f $$j ] ; then mv $$j precomptmp/$$j ; fi ; done ; done ;\
+ for i in $(exesnames) ; do for j in results/sizes/js_of_ocaml/*/$$i ; do if [ -f $$j ] ; then mv $$j precomptmp/$$j ; fi ; done ; done ;\
+ for i in $(exesnames) ; do for j in results/sizes/*/$$i ; do if [ -f $$j ] ; then mv $$j precomptmp/$$j ; fi ;done ; done ;\
+ fi
+
+__missingcompiletimes:
+ mkdir -p results/compiletimes/`hostname`/byte/
+ for i in $(missingcompiletimes) ; do if [ ! -f $$i ] ; then echo 0 > $$i ; fi ; done
+ touch __missingcompiletimes
+
+__possiblymissingbenchs:
+ for i in $(possiblymissingbenchs) ; do if [ ! -f $$i ] ; then echo 0 > $$i ; fi ; done
+ touch __possiblymissingbenchs
+
+__missingsizes: __precomp
+ for i in $(missingsizes) ; do if [ ! -f $$i ] ; then echo 0 > $$i ; fi ; done
+ if [ -f results/sizes/ml/unison ] ; then echo 828471 > results/sizes/ml/unison ; fi
+ if [ -f results/sizes/ml/ocamlc ] ; then echo 800771 > results/sizes/ml/ocamlc ; fi
+ if [ -f results/sizes/ml/ocsigen_server ] ; then echo 0 > results/sizes/ml/ocsigen_server ; fi
+ if [ -f results/sizes/ml/js_of_ocaml ] ; then echo 171361 > results/sizes/ml/js_of_ocaml ; fi
+ if [ -f results/sizes/ml/boulderdash ] ; then echo 12920 > results/sizes/ml/boulderdash ; fi
+ if [ -f results/sizes/ml/canvas ] ; then echo 740 > results/sizes/ml/canvas ; fi
+ if [ -f results/sizes/ml/cubes ] ; then echo 3773 > results/sizes/ml/cubes ; fi
+ if [ -f results/sizes/ml/minesweeper ] ; then echo 7106 > results/sizes/ml/minesweeper ; fi
+ if [ -f results/sizes/ml/planet ] ; then echo 16488 > results/sizes/ml/planet ; fi
+ if [ -f results/sizes/ml/sudoku ] ; then echo 2837 > results/sizes/ml/sudoku ; fi
+ touch __missingsizes
+# file sizes (without comments and spaces)
+# find ../examples/sudoku/ -name "*.ml" -exec cat {} \; | perl /home/balat/kroko/js_of_ocaml/benchmarks/lib/remove_comments.pl | sed 's/^ *//g' | wc -c
+
+# To generate SVG, we first need to run the benchs,
+# then to add data for precompiled programs
+time.svg: __run
+ $(REPORT) -config report-time.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -max 5.5 -svg 7 500 150 -edgecaption -ylabel "Execution time" \
+ > $@
+
+size.svg: size.gpl
+ gnuplot < $^ > $@
+
+size.gpl: __run __missingsizes
+ $(REPORT) -config report-size.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -omit fannkuch_redux_2 \
+ -omit boyer_no_exc -omit kb_no_exc \
+ -append boulderdash \
+ -append canvas \
+ -append cubes \
+ -append minesweeper \
+ -append planet \
+ -append sudoku \
+ -append js_of_ocaml \
+ -append ocsigen_server \
+ -append ocamlc \
+ -append unison \
+ -max 3 -ylabel Size -script \
+ -svg 7 650 150 \
+ | perl -pe 'BEGIN{undef $$/;} s/e\nplot/e\nset key at 23.75,1.80\nplot/smg' \
+ > $@
+
+time-optim.svg: __run
+ $(REPORT) -config report-time-optim.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -omit fannkuch_redux_2 \
+ -max 4 -svg 7 400 150 -edgecaption -ylabel "Execution time" \
+ > $@
+
+size-optim.svg: __run __missingsizes
+ $(REPORT) -config report-size-optim.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -omit fannkuch_redux_2 \
+ -omit boyer_no_exc -omit kb_no_exc \
+ -append boulderdash \
+ -append canvas \
+ -append cubes \
+ -append minesweeper \
+ -append planet \
+ -append sudoku \
+ -append js_of_ocaml \
+ -append ocsigen_server \
+ -append ocamlc \
+ -append unison \
+ -max 2.5 -svg 7 650 150 -edgecaption -ylabel Size \
+ > $@
+
+time-ocamljs.svg: __run
+ $(REPORT) -config report-time-ocamljs.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -omit fannkuch_redux_2 \
+ -max 5.5 -svg 7 500 150 -edgecaption -ylabel "Execution time" \
+ > $@
+
+size-ocamljs.svg: __run __precomp
+ $(REPORT) -config report-size-ocamljs.config -omit loop \
+ -omit binary_trees -omit fannkuch_redux \
+ -omit fannkuch_redux_2 \
+ -omit spectral_norm \
+ -omit boyer_no_exc -omit kb_no_exc \
+ -omit boulderdash \
+ -omit canvas \
+ -omit cubes \
+ -omit minesweeper \
+ -omit planet \
+ -omit sudoku \
+ -omit js_of_ocaml \
+ -omit ocsigen_server \
+ -omit ocamlc \
+ -omit unison \
+ -max 5.5 -svg 7 500 150 -edgecaption -ylabel Size \
+ > $@
+
+compiletime.svg: __run __precomp __missingcompiletimes
+ $(REPORT) -config report-compiletime.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -max 2 -svg 7 500 150 -edgecaption -ylabel "Compile time" \
+ > $@
+
+nativejs.svg: __run
+ $(REPORT) -config report-nativejs.config \
+ -omit binary_trees -omit fannkuch_redux -omit loop \
+ -max 2.8 -svg 7 200 150 -edgecaption -ylabel "Execution time" \
+ > $@
+
+
+%.pdf: %.svg
+ inkscape -D --export-pdf="$@" -w 210 -h 297 $<
+
+_perf:
+ for i in /sys/devices/system/cpu/cpu* ; do if [ -f $$i/cpufreq/scaling_governor ] ; then sudo bash -c "echo performance > $$i/cpufreq/scaling_governor" ; fi ;done
+
+_noperf:
+ for i in /sys/devices/system/cpu/cpu* ; do if [ -f $$i/cpufreq/scaling_governor ] ; then sudo bash -c "echo ondemand > $$i/cpufreq/scaling_governor" ; fi ; done
+
+
+clean: _noperf
+ rm -rf results build __precomp __run *.svg *.pdf *~ precomptmp __missingsizes __missingcompiletimes __possiblymissingbenchs
diff -Nru js-of-ocaml-1.4/benchmarks/report-compiletime.config js-of-ocaml-2.2/benchmarks/report-compiletime.config
--- js-of-ocaml-1.4/benchmarks/report-compiletime.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-compiletime.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,7 @@
+histogram compiletimes "" opt #729fcf ocamlopt
+histogram compiletimes "" byte #204a87 ocamlc
+histogramref compiletimes "" js_of_ocaml #d98e2d js_of_ocaml
+histogram compiletimes "" nodeadcode #fb3f00 No deadcode elimination
+histogram compiletimes "" noinline #fb7f1f No inlining
+histogram compiletimes "" nooptcall #a75f0c No call optimisation
+histogram compiletimes "" notcompact #fb5f0f No compact expression
diff -Nru js-of-ocaml-1.4/benchmarks/report.config.sample js-of-ocaml-2.2/benchmarks/report.config.sample
--- js-of-ocaml-1.4/benchmarks/report.config.sample 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report.config.sample 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,6 @@
+histogram times "" opt #729fcf ocamlopt
+histogramref times "" byte #204a87 ocamlc
+histogram times oldv8 js_of_ocaml #fbaf4f old V8
+histogram times v8 js_of_ocaml #d98e2d V8
+histogram times nitro js_of_ocaml #a75f0c Nitro
+histogram times tm js_of_ocaml #a40000 TraceMonkey
diff -Nru js-of-ocaml-1.4/benchmarks/report-js.config js-of-ocaml-2.2/benchmarks/report-js.config
--- js-of-ocaml-1.4/benchmarks/report-js.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-js.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,2 @@
+histogramref times v8 js_of_ocaml #d98e2d compiled to JS (V8)
+histogram times v8 js #d9112d native JS (V8)
diff -Nru js-of-ocaml-1.4/benchmarks/report.ml js-of-ocaml-2.2/benchmarks/report.ml
--- js-of-ocaml-1.4/benchmarks/report.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,480 @@
+#! /usr/bin/ocaml unix.cma
+(* Js_of_ocaml benchmarks
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2011 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+#use "lib/common.ml"
+
+(****)
+
+let reference = ref None
+let nreference = ref (-1)
+let maximum = ref (-1.)
+let gnuplot = ref true
+let table = ref false
+let omitted = ref []
+let appended = ref []
+let errors = ref false
+let script = ref false
+let conf = ref "report.config"
+let svg = ref false
+let svgfontsize = ref 7
+let svgwidth = ref 500
+let svgheight = ref 150
+let edgecaption = ref false
+let ylabel = ref ""
+
+(****)
+
+let str_split s c =
+ let i = ref (String.length s) in
+ let r = ref [] in
+ begin try
+ while true do
+ let j = String.rindex_from s (!i - 1) c in
+ r := String.sub s (j + 1) (!i - j - 1) :: !r;
+ i := j
+ done
+ with Not_found -> () end;
+ String.sub s 0 !i :: !r
+
+(****)
+
+let rec merge f l1 l2 =
+ match l1, l2 with
+ [], _ | _, [] ->
+ []
+ | (n1, v1) :: r1, (n2, v2) :: r2 ->
+ if n1 < n2 then
+ merge f r1 l2
+ else if n1 > n2 then
+ merge f l1 r2
+ else
+ (n1, f v1 v2) :: merge f r1 r2
+
+let merge_blank l2 =
+ List.map (fun (n2, v2) -> (n2, (0.0, 0.0) :: v2)) l2
+
+let read_column ?title ?color meas spec refe =
+ let l =
+ List.map
+ (fun nm ->
+ let l = read_measures meas spec nm in
+ let a = Array.of_list l in
+ let (m, i) = mean_with_confidence a in
+ (nm, [(m, i)]))
+ (benchs meas (no_ext spec))
+ in
+ let nm =
+ match title with
+ | Some nm -> nm
+ | None -> dir meas (no_ext spec)
+ in
+ if refe then reference := Some l;
+ Some ([Some (nm, color)], l)
+
+let read_blank_column () = None
+
+let rec list_create n a =
+ if n = 0
+ then []
+ else a::list_create (n-1) a
+
+let merge_columns l old_table =
+ let rec aux = function
+ | [] | [None] -> ([], [])
+ | [Some c] -> c
+ | Some (h, c) :: r ->
+ let (h', t) = aux r in
+ (h @ h', merge (fun v1 v2 -> v1 @ v2) c t)
+ | None :: r ->
+ let (h', t) = aux r in
+(*VVV utile ? *)
+ (None::h', merge_blank t)
+ in
+ let rec remove_head_blank = function
+ | None :: l -> let (n, ll) = remove_head_blank l in (n+1, ll)
+ | l -> (0, l)
+ in
+ let rec add_blanks n (h, t) =
+ if n = 0
+ then (h, t)
+ else
+ let zeros = list_create n (0.0, 0.0) in
+
+(*VVV utile ? *)
+ let nodisplays = list_create n None in
+
+ (h @ nodisplays , List.map (fun (a, l) -> (a, l @ zeros)) t)
+ in
+ (* if there was an old table, we keep only the lines corresponding
+ to entries in that table *)
+ let l = match l, old_table with
+ | [], _ -> []
+ | _, None -> l
+ | (Some (h, c))::ll, Some o ->
+ (Some (h, (merge (fun v1 v2 -> v1) c o)))::ll
+ | None::ll, Some o ->
+ (Some ([None], (List.map (fun (nm, _) -> (nm, [0.0, 0.0])) o)))::ll
+ in
+ let (nb_blanks, l) = remove_head_blank (List.rev l) in
+ let l = List.rev l in
+ add_blanks nb_blanks (aux l)
+
+let normalize (h, t) =
+ match !reference with
+ | None -> (h, t)
+ | Some rr ->
+ (h,
+ List.map
+ (fun (nm, l) ->
+ let (r, _) = List.hd (List.assoc nm rr) in
+ if r <> r then begin
+ Format.eprintf "No reference available for '%s'@." nm;
+ exit 1
+ end;
+ (nm, List.map (fun (v, i) -> (v /. r, i /. r)) l))
+ t)
+
+let stats (h, t) =
+ for i = 0 to List.length h - 1 do
+ match List.nth h i with
+ | Some (nm, _) ->
+ let l = List.map (fun (_, l) -> fst (List.nth l i)) t in
+ let a = Array.of_list l in
+ Array.sort compare a;
+ let p = List.fold_right (fun x p -> x *. p) l 1. in
+ Format.eprintf "%s:@. %f %f@." nm
+ (p ** (1. /. float (List.length l)))
+ a.(Array.length a / 2)
+ | None -> ()
+ done
+
+let text_output _no_header (h, t) =
+ Format.printf "-";
+ List.iter (fun v ->
+ let nm = match v with
+ | Some (nm, _) -> nm
+ | None -> ""
+ in
+ Format.printf " - \"%s\"" nm) h;
+ Format.printf "@.";
+ List.iter
+ (fun (nm, l) ->
+ Format.printf "%s" nm;
+ List.iter (fun (m, i) -> Format.printf " %f %f" m i) l;
+ Format.printf "@.")
+ t
+
+let gnuplot_output ch no_header (h, t) =
+ let n = List.length (snd (List.hd t)) in
+ if not no_header
+ then begin
+ if !svg
+ then Printf.fprintf ch "set terminal svg fsize %d size %d %d\n" !svgfontsize !svgwidth !svgheight;
+ if !edgecaption
+ then Printf.fprintf ch "set key tmargin horizontal Left left reverse\n";
+ Printf.fprintf ch "\
+ set multiplot\n\
+ set style data histograms\n\
+ set style fill solid 1 border rgb 'black'\n\
+ set style histogram errorbars gap 1%s\n\
+ set xtics border in scale 0,0 nomirror rotate by -30 \
+ offset character 0, 0, 0\n"
+ (if !errors then " lw 1" else "");
+ if !ylabel <> "" then Printf.fprintf ch "set ylabel \"%s\"\n" !ylabel;
+ if !maximum > 0. then
+ Printf.fprintf ch "set yrange [0:%f]\n" !maximum
+ else
+ Printf.fprintf ch "set yrange [0:]\n";
+ end;
+
+ (* labels *)
+ for i = 0 to n - 1 do
+ let nn = ref 0. in
+ List.iter
+ (fun (nm, l) ->
+ let (v, ii) = List.nth l i in
+ if !maximum > 0. && v > !maximum
+ then Printf.fprintf ch "set label font \",5\" \"%.2f\" at %f,%f center\n"
+ v (!nn +. float i /. float n -. 0.5 (* why? *))
+ (!maximum *. 1.04 +. 0.1);
+ nn := !nn +. 1.)
+ t;
+ done;
+
+ Printf.fprintf ch "plot";
+ for i = 0 to n - 1 do
+ match List.nth h i with
+ | Some (_, col) ->
+ if i > 0
+ then Printf.fprintf ch ", \"-\" using 2:3 title columnhead lw 0"
+ else Printf.fprintf ch " \"-\" using 2:3:xtic(1) title columnhead lw 0";
+ (match col with
+ | Some c -> Printf.fprintf ch " lc rgb '%s'" c
+ | None -> ());
+ | None ->
+ if i > 0
+ then Printf.fprintf ch ", \"-\" using 2:3 title columnhead lw 0"
+ else Printf.fprintf ch " \"-\" using 2:3:xtic(1) title columnhead lw 0";
+(* notitle does not work ... I don't know why ... *)
+ done;
+ Printf.fprintf ch "\n";
+ for i = 0 to n - 1 do
+ let nm = match List.nth h i with
+ | Some (nm, _) -> nm
+ | None -> ""
+ in
+ Printf.fprintf ch "- - \"%s\"\n" nm;
+ List.iter
+ (fun (nm, l) ->
+ let (v, ii) = List.nth l i in
+ Printf.fprintf ch "\"%s\" %f %f\n" nm v (if ii <> ii then 0. else ii))
+ t;
+ Printf.fprintf ch "e\n"
+ done
+
+let filter (h, t) =
+ let l1 = List.filter
+ (fun (nm, _) ->
+ not ((List.mem nm !appended) || (List.mem nm !omitted)))
+ t
+ in
+ let app =
+ List.fold_left
+ (fun beg nm -> try (nm, List.assoc nm t)::beg with Not_found -> beg)
+ [] !appended
+ in
+ (h, l1 @ app)
+
+let output_table =
+ let old_table = ref None in
+ fun r (l: ((string * 'a option) option list * _) option list) f ->
+ let t = merge_columns l !old_table in
+ old_table := Some (snd t);
+ let t = filter t in
+ let t = normalize t in
+ stats t;
+ f t
+
+let output_tables r conf =
+ let output_function, close =
+ if !table
+ then text_output, fun () -> ()
+ else if !script
+ then gnuplot_output stdout, fun () -> ()
+ else begin
+ let ch = Unix.open_process_out "gnuplot -persist" in
+ (gnuplot_output ch,
+ fun () -> close_out ch)
+ end
+ in
+ let no_header = ref false in
+ List.iter
+ (fun conf ->
+ output_table r
+ (List.map
+ (function
+ | None -> read_blank_column ()
+ | Some (dir1, dir2, color, title, refe) ->
+ read_column ~title ~color dir1 (dir2, "") refe)
+ conf)
+ (output_function !no_header);
+ no_header := true;
+ )
+ conf;
+ close ()
+
+
+(*
+let f _ =
+ let c1 = read_column (times ^ "/v8") js_of_ocaml in
+ let c2 = read_column (times ^ "/v8") ocamljs in
+ output_table 1 [c1; c2]
+*)
+
+(*
+let f _ =
+ let c1 = read_column times opt in
+ let c2 = read_column times byte in
+ let c3 = read_column (times ^ "/v8") js_of_ocaml in
+ output_table 1 [c3; c2; c1]
+*)
+
+(*
+let f _ =
+ let c1 = read_column (times ^ "/v8") js_of_ocaml in
+ let c2 = read_column (times ^ "/v8") js_of_ocaml_unsafe in
+ output_table 1 [c1; c2]
+
+let f _ =
+ let o = read_column ~title:"ocamlopt" ~color:"#729fcf" times opt in
+ let b = read_column ~title:"ocamlc" ~color:"#204a87" times byte in
+ let c0 = read_column ~title:"old V8 (august?)" ~color:"#fbaf4f" (times ^ "/oldv8") js_of_ocaml in
+ let c1 = read_column ~title:"V8" ~color:"#d98e2d" (times ^ "/v8") js_of_ocaml in
+ let c2 = read_column ~title:"Nitro" ~color:"#a75f0c" (times ^ "/nitro") js_of_ocaml in
+ let c3 = read_column ~title:"TraceMonkey" ~color:"#a40000" (times ^ "/tm") js_of_ocaml in
+ output_table 2 [o; b; c0; c1; c2; c3]
+*)
+
+(*
+
+let f _ =
+ let o = read_column ~title:"ocamlopt" ~color:"#729fcf" times opt in
+ let b = read_column ~title:"ocamlc" ~color:"#326bbe" times byte in
+ let c1 = read_column ~title:"V8" ~color:"#d98e2d" (times ^ "/v8") js_of_ocaml in
+ let c2 = read_column ~title:"Nitro" ~color:"#a75f0c" (times ^ "/nitro") js_of_ocaml in
+ output_table 2 [o; b; c1; c2]
+*)
+
+(*
+let f _ =
+ let engine = "v8" in
+ let c1 = read_column (times ^ "/" ^ engine) js in
+ let c2 = read_column (times ^ "/" ^ engine) js_of_ocaml in
+ output_table 2 [c1; c2]
+*)
+
+(*
+let f _ =
+ let c1 = read_column sizes ml in
+ let c2 = read_column sizes byte in
+ let c3 = read_column sizes (sub_spec js_of_ocaml "full") in
+ let c4 = read_column sizes (sub_spec js_of_ocaml "generated") in
+ let c5 = read_column sizes ocamljs in
+ output_table 3 [c1; c2; c3; c4; c5]
+*)
+
+(*
+let f _ =
+ let c1 = read_column sizes (sub_spec js_of_ocaml "generated") in
+ let c2 = read_column sizes js_of_ocaml_compact in
+ let c3 = read_column sizes js_of_ocaml_inline in
+ let c4 = read_column sizes js_of_ocaml_deadcode in
+ output_table 1 [c1; c2; c3; c4]
+*)
+
+(*
+let f _ =
+ let c2 = read_column ~title:"bytecode" ~color:"#326bbe" sizes byte in
+ let c3 = read_column ~title:"Javascript" ~color:"#a75f0c" sizes (sub_spec js_of_ocaml "full") in
+ output_table 1 [c2; c3]
+*)
+
+(****)
+
+let read_config () =
+ let f = !conf in
+ if not (Sys.file_exists f) then begin
+ Format.eprintf "Configuration file '%s' not found!@." f;
+ exit 1
+ end;
+ let fullinfo = ref [] in
+ let info = ref [] in
+ let i = ref 0 in
+ let reference = ref false in
+ let ch = open_in f in
+ let split_at_space l =
+ try
+ let i = String.index l ' ' in
+ (String.sub l 0 i, String.sub l (i + 1) (String.length l - i - 1))
+ with Not_found -> (l, "")
+ in
+ let get_info dir0 rem refe =
+ let (dir1, rem) = split_at_space rem in
+ let (dir2, rem) = split_at_space rem in
+ let (color, title) = split_at_space rem in
+ let dir1 = if dir1 = "\"\"" then dir0 else dir0^"/"^dir1 in
+ info := Some (dir1, dir2, color, title, refe) :: !info
+ in
+ begin try
+ while true do
+ let l = input_line ch in
+ if String.length l = 0
+ then
+ (if !info <> []
+ then (fullinfo := (List.rev !info)::!fullinfo ; info := []; i:=0))
+ else
+ if l.[0] <> '#'
+ then begin
+ incr i;
+ reference := !nreference = !i;
+ let (kind, rem) = split_at_space l in
+ let (kind2, rem) = split_at_space rem in
+ (match kind with
+ | "histogram" -> ()
+ | "histogramref" ->
+ if !nreference = -1 then reference := true
+ | _ ->
+ Format.eprintf "Unknown config options '%s'@." kind;
+ exit 1);
+ (match kind2 with
+ | "blank" -> info := None :: !info
+ | "times" -> get_info times rem !reference
+ | "compiletimes" -> get_info compiletimes rem !reference
+ | "sizes" -> get_info sizes rem !reference
+ | _ ->
+ Format.eprintf "Unknown config options '%s'@." kind2;
+ exit 1);
+ end
+ done
+ with End_of_file -> () end;
+ close_in ch;
+ if !info <> [] then fullinfo := (List.rev !info)::!fullinfo;
+ (!reference, List.rev !fullinfo)
+
+let _ =
+ let options =
+ [("-ref", Arg.Set_int nreference, "
use column
as the baseline");
+ ("-max", Arg.Set_float maximum, " truncate graph at level ");
+ ("-table", Arg.Set table, " output a text table");
+ ("-omit", Arg.String (fun s -> omitted := str_split s ',' @ !omitted),
+ " omit the given benchmark");
+ ("-append", Arg.String (fun s -> appended := str_split s ',' @ !appended),
+ " append the given benchmark at the end");
+ ("-errors", Arg.Set errors, " display error bars");
+ ("-config", Arg.Set_string conf, " use as a config file");
+ ("-script", Arg.Set script, " output gnuplot script");
+ ("-svg", Arg.Tuple [Arg.Set svg;
+ Arg.Set_int svgfontsize;
+ Arg.Set_int svgwidth;
+ Arg.Set_int svgheight],
+ " svg output");
+ ("-edgecaption", Arg.Set edgecaption, " display caption outside the diagram");
+ ("-ylabel", Arg.Set_string ylabel, " Y axis label");
+ ]
+ in
+ Arg.parse (Arg.align options)
+ (fun s -> raise (Arg.Bad (Format.sprintf "unknown option `%s'" s)))
+ (Format.sprintf "Usage: %s [options]" Sys.argv.(0));
+
+ let r, conf = read_config () in
+
+ output_tables r conf
+
+(* f () *)
+
+(*
+http://hacks.mozilla.org/2009/07/tracemonkey-overview/
+http://weblogs.mozillazine.org/bz/archives/020732.html
+*)
+
+(*
+./report.ml -max 4 -omit hamming
+*)
diff -Nru js-of-ocaml-1.4/benchmarks/report-nativejs.config js-of-ocaml-2.2/benchmarks/report-nativejs.config
--- js-of-ocaml-1.4/benchmarks/report-nativejs.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-nativejs.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,2 @@
+histogram times v8 js #775588 native JS (V8)
+histogramref times v8 js_of_ocaml #fbaf4f compiled to JS (V8)
diff -Nru js-of-ocaml-1.4/benchmarks/report-size.config js-of-ocaml-2.2/benchmarks/report-size.config
--- js-of-ocaml-1.4/benchmarks/report-size.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-size.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,17 @@
+histogram sizes "" ml #83afdf Source
+histogram sizes "" byte #204a87 Bytecode
+histogramref sizes "" js_of_ocaml/full #371f00 Runtime
+#histogram sizes "" ocamljs #22bb22 Ocamljs
+
+# second layer
+#histogram sizes "" ml #729fcf Source
+#histogram sizes "" byte #204a87 Bytecode
+#histogram sizes "" js_of_ocaml/generated #fbaf4f Generated code
+#histogram sizes "" ocamljs #22bb22 Ocamljs generated code
+
+histogram blank
+histogram blank
+histogram sizes "" js_of_ocaml/generated #fbaf4f Generated code
+#histogram blank
+
+
diff -Nru js-of-ocaml-1.4/benchmarks/report-size-ocamljs.config js-of-ocaml-2.2/benchmarks/report-size-ocamljs.config
--- js-of-ocaml-1.4/benchmarks/report-size-ocamljs.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-size-ocamljs.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,2 @@
+histogramref sizes "" js_of_ocaml/gzipped #fbaf4f js_of_ocaml (gzipped)
+histogram sizes "" ocamljs #22bb22 Ocamljs (gzipped)
diff -Nru js-of-ocaml-1.4/benchmarks/report-size-optim.config js-of-ocaml-2.2/benchmarks/report-size-optim.config
--- js-of-ocaml-1.4/benchmarks/report-size-optim.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-size-optim.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,8 @@
+#histogram sizes "" unsafe/js_of_ocaml #fb9f3f Unsafe
+histogramref sizes "" js_of_ocaml/generated #fbaf4f Default
+#histogram sizes "" nooptcall #a75f0c no optimization of calls
+histogram sizes "" noinline #d98e2d no inlining
+histogram sizes "" notcompact #a75f0c no compact code
+histogram sizes "" nodeadcode #752d09 no dead code removal
+#histogram sizes "" ocamljs #227722 Ocamljs generated code
+#histogram sizes "" unsafe/ocamljs #229922 Ocamljs + unsafe
diff -Nru js-of-ocaml-1.4/benchmarks/report-time.config js-of-ocaml-2.2/benchmarks/report-time.config
--- js-of-ocaml-1.4/benchmarks/report-time.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-time.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,6 @@
+histogram times "" opt #729fcf ocamlopt
+histogram times "" byte #204a87 ocamlc
+#histogram times oldv8 js_of_ocaml #fbaf4f old V8
+histogramref times v8 js_of_ocaml #fbaf4f V8
+histogram times nitro js_of_ocaml #96c296 Nitro
+histogram times tm js_of_ocaml #fb4f4f JaegerMonkey
diff -Nru js-of-ocaml-1.4/benchmarks/report-time-ocamljs.config js-of-ocaml-2.2/benchmarks/report-time-ocamljs.config
--- js-of-ocaml-1.4/benchmarks/report-time-ocamljs.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-time-ocamljs.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,2 @@
+histogramref times v8 js_of_ocaml #d98e2d js_of_ocaml (V8)
+histogram times v8 ocamljs #227722 ocamljs (V8)
diff -Nru js-of-ocaml-1.4/benchmarks/report-time-optim.config js-of-ocaml-2.2/benchmarks/report-time-optim.config
--- js-of-ocaml-1.4/benchmarks/report-time-optim.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/report-time-optim.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,3 @@
+histogramref times v8 js_of_ocaml #fbaf4f default
+histogram times v8 unsafe/js_of_ocaml #d98e2d unsafe
+histogram times v8 nooptcall #a75f0c No call optimisation
diff -Nru js-of-ocaml-1.4/benchmarks/run.config js-of-ocaml-2.2/benchmarks/run.config
--- js-of-ocaml-1.4/benchmarks/run.config 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/run.config 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,4 @@
+interpreter v8 /home/vincent/src/js/v8-read-only/shell
+interpreter tm /home/vincent/src/js/mozilla-central-7dda35eab7fc/objdir-ff-release/dist/bin/js -j -m
+interpreter nitro /home/vincent/src/js/WebKit/Programs/jsc
+#interpreter oldv8 /usr/bin/nodejs
diff -Nru js-of-ocaml-1.4/benchmarks/run.config.sample js-of-ocaml-2.2/benchmarks/run.config.sample
--- js-of-ocaml-1.4/benchmarks/run.config.sample 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/run.config.sample 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,3 @@
+interpreter v8 /home/vouillon/Js_of_ocaml_benchs/v8-read-only/d8
+interpreter tm /home/vouillon/Js_of_ocaml_benchs/tracemonkey/js/src/js -j -m
+interpreter nitro /home/vouillon/Js_of_ocaml_benchs/WebKit/WebKitBuild/Release/Programs/jsc
diff -Nru js-of-ocaml-1.4/benchmarks/run.ml js-of-ocaml-2.2/benchmarks/run.ml
--- js-of-ocaml-1.4/benchmarks/run.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/run.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,265 @@
+#! /usr/bin/ocaml unix.cma
+(* Js_of_ocaml benchmarks
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2011 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let verbose = ref true;;
+
+#use "lib/common.ml"
+
+(****)
+
+let run_command cmd =
+ if !verbose then Format.printf "+ %s@." cmd;
+ match Unix.system cmd with
+ Unix.WEXITED res when res <> 0 ->
+ Format.eprintf "Command '%s' failed with exit code %d.@." cmd res;
+ raise Exit
+ | Unix.WSIGNALED s ->
+ Format.eprintf "Command '%s' killed with signal %d.@." cmd s;
+ raise Exit
+ | _ ->
+ ()
+
+let time cmd =
+ let t1 = (Unix.times ()).Unix.tms_cutime in
+ run_command cmd;
+ let t2 = (Unix.times ()).Unix.tms_cutime in
+ t2 -. t1
+
+(****)
+
+let compile_gen ~comptime prog src_dir src_spec dst_dir dst_spec =
+ mkdir (dir dst_dir dst_spec);
+ List.iter
+ (fun nm ->
+ let src = file src_dir src_spec nm in
+ let dst = file dst_dir dst_spec nm in
+ if need_update src dst then begin
+ let cmd = prog src dst in
+ try
+ if comptime
+ then write_measures compiletimes dst_spec nm [time cmd]
+ else run_command cmd
+ with Exit -> ()
+
+ end)
+ (benchs src_dir src_spec)
+
+let compile ~comptime prog =
+ compile_gen ~comptime (Format.sprintf "%s %s -o %s" prog)
+
+let warm_up_time = 1.0
+let min_measures = ref 10
+let max_confidence = ref 0.03
+let max_duration = ref 1200.
+
+let fast_run () =
+ min_measures := 5; max_confidence := 0.15; max_duration := 30.
+
+let ffast_run () =
+ min_measures := 2; max_confidence := 42.; max_duration := 30.
+
+(****)
+
+let need_more l =
+ let a = Array.of_list l in
+ let (m, i) = mean_with_confidence a in
+ let n = Array.length a in
+ Format.eprintf "==> %f +/- %f / %f %d@." m i (i /. m) n;
+ n < !min_measures || (i /. m > !max_confidence /. 2.)
+
+let warm_up cmd =
+ let t = ref 0. in
+ while !t < warm_up_time do
+ let t' = time cmd in
+ if t' > !max_duration then raise Exit;
+ t := !t +. t'
+ done
+
+let rec measure_rec cmd l =
+ let t = time cmd in
+ let l = t :: l in
+ if need_more l then measure_rec cmd l else l
+
+let measure_one code meas spec nm cmd =
+ let l =
+ if measures_need_update code meas spec nm then [] else
+ read_measures meas spec nm
+ in
+ if need_more l then begin
+ warm_up cmd;
+ let l = measure_rec cmd l in
+ write_measures meas spec nm l;
+ l
+ end else
+ l
+
+let measure code meas spec cmd =
+ List.iter
+ (fun nm ->
+ let cmd = cmd ^ file code spec nm in
+ try
+ ignore (measure_one code meas spec nm cmd)
+ with Exit -> ())
+ (benchs code spec)
+
+(****)
+
+let compile_no_ext ~comptime prog src_dir src_spec dst_dir dst_spec =
+ compile_gen ~comptime prog src_dir src_spec dst_dir (no_ext dst_spec)
+
+let ml_size =
+ compile_no_ext
+ ~comptime:false
+ (Format.sprintf "perl ./lib/remove_comments.pl %s | sed 's/^ *//g' | wc -c > %s")
+
+let file_size =
+ compile_no_ext ~comptime:false (Format.sprintf "wc -c < %s > %s")
+
+let compr_file_size =
+ compile_no_ext
+ ~comptime:false
+ (Format.sprintf "sed 's/^ *//g' %s | gzip -c | wc -c > %s")
+
+(* let runtime_size = *)
+(* compile_no_ext ~comptime:false (Format.sprintf "head -n -1 %s | wc -c > %s") *)
+
+let gen_size =
+ compile_no_ext ~comptime:false (Format.sprintf "tail -1 %s | wc -c > %s")
+
+(****)
+
+let compile_only = ref false
+let full = ref false
+let conf = ref "run.config"
+let do_ocamljs = ref true
+let nobyteopt = ref false
+
+let has_ocamljs = Sys.command "ocamljs 2> /dev/null" = 0
+let run_ocamljs () = !do_ocamljs && has_ocamljs
+
+
+let interpreters = ref []
+
+let read_config () =
+ let f = !conf in
+ if not (Sys.file_exists f) then begin
+ Format.eprintf "Configuration file '%s' not found!@." f;
+ exit 1
+ end;
+ let i = ref [] in
+ let ch = open_in f in
+ let split_at_space l =
+ let i = String.index l ' ' in
+ (String.sub l 0 i, String.sub l (i + 1) (String.length l - i - 1))
+ in
+ begin try
+ while true do
+ let l = input_line ch in
+ if l.[0] <> '#'
+ then begin
+ try
+ let (kind, rem) = split_at_space l in
+ match kind with
+ "interpreter" ->
+ let (nm, cmd) = split_at_space rem in
+ i := (cmd ^ " ", nm) :: !i
+ | _ ->
+ Format.eprintf "Unknown config option '%s'@." kind;
+ exit 1
+ with Not_found ->
+ Format.eprintf "Bad config line '%s'@." l;
+ exit 1
+ end
+ done
+ with End_of_file -> () end;
+ close_in ch;
+ interpreters := List.rev !i
+
+let _ =
+ let options =
+ [("-compile", Arg.Set compile_only, " only compiles");
+ ("-all", Arg.Set full, " run all benchmarks");
+ ("-config", Arg.Set_string conf, " use as a config file");
+ ("-fast", Arg.Unit fast_run, " perform less iterations");
+ ("-ffast", Arg.Unit ffast_run, " perform very few iterations");
+ ("-noocamljs", Arg.Clear do_ocamljs, " do not run ocamljs");
+ ("-nobyteopt", Arg.Set nobyteopt, " do not run benchs on bytecode and native programs")]
+ in
+ Arg.parse (Arg.align options)
+ (fun s -> raise (Arg.Bad (Format.sprintf "unknown option `%s'" s)))
+ (Format.sprintf "Usage: %s [options]" Sys.argv.(0));
+
+ read_config ();
+
+ compile ~comptime:true "ocamlc" src ml code byte;
+ compile ~comptime:true "ocamlopt" src ml code opt;
+ compile ~comptime:true "js_of_ocaml" code byte code js_of_ocaml;
+ compile ~comptime:true "js_of_ocaml -disable inline" code byte code js_of_ocaml_inline;
+ compile ~comptime:true "js_of_ocaml -disable deadcode" code byte code js_of_ocaml_deadcode;
+ compile ~comptime:true "js_of_ocaml -disable compact" code byte code js_of_ocaml_compact;
+ compile ~comptime:true "js_of_ocaml -disable optcall" code byte code js_of_ocaml_call;
+ if run_ocamljs () then compile ~comptime:true "ocamljs" src ml code ocamljs;
+ compile ~comptime:true "ocamlc -unsafe" src ml code byte_unsafe;
+ compile ~comptime:true "ocamlopt" src ml code opt_unsafe;
+ compile ~comptime:true "js_of_ocaml" code byte_unsafe code js_of_ocaml_unsafe;
+ if run_ocamljs () then compile ~comptime:true "ocamljs -unsafe" src ml code ocamljs_unsafe;
+
+ ml_size src ml sizes ml;
+ file_size code byte sizes byte;
+ file_size code js_of_ocaml sizes (sub_spec js_of_ocaml "full");
+ compr_file_size code js_of_ocaml sizes (sub_spec js_of_ocaml "gzipped");
+ (* runtime_size code js_of_ocaml sizes (sub_spec js_of_ocaml "runtime"); *)
+ gen_size code js_of_ocaml sizes (sub_spec js_of_ocaml "generated");
+ gen_size code js_of_ocaml_inline sizes js_of_ocaml_inline;
+ gen_size code js_of_ocaml_deadcode sizes js_of_ocaml_deadcode;
+ gen_size code js_of_ocaml_compact sizes js_of_ocaml_compact;
+ gen_size code js_of_ocaml_call sizes js_of_ocaml_call;
+ if run_ocamljs () then compr_file_size code ocamljs sizes ocamljs;
+
+ if !compile_only then exit 0;
+
+ if not !nobyteopt then begin
+ measure code times opt "";
+ measure code times byte "";
+ end;
+
+ let (compilers, suites) =
+ if !full then
+ (!interpreters,
+ [js_of_ocaml;
+ js_of_ocaml_unsafe;
+ js_of_ocaml_inline;
+ js_of_ocaml_deadcode;
+ js_of_ocaml_compact;
+ js_of_ocaml_call;
+ ocamljs;
+ ocamljs_unsafe; ])
+ else
+ (begin match !interpreters with i :: r -> [i] | [] -> [] end,
+ [js_of_ocaml])
+ in
+ List.iter
+ (fun (comp, dir) ->
+ measure src (Filename.concat times dir) js comp;
+ List.iter
+ (fun suite -> measure code (Filename.concat times dir) suite comp)
+ suites)
+ compilers
diff -Nru js-of-ocaml-1.4/benchmarks/sources/js/bdd.js js-of-ocaml-2.2/benchmarks/sources/js/bdd.js
--- js-of-ocaml-1.4/benchmarks/sources/js/bdd.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/js/bdd.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,280 @@
+// (***********************************************************************)
+// (* *)
+// (* Objective Caml *)
+// (* *)
+// (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+// (* *)
+// (* Copyright 1996 Institut National de Recherche en Informatique et *)
+// (* en Automatique. All rights reserved. This file is distributed *)
+// (* under the terms of the Q Public License version 1.0. *)
+// (* *)
+// (***********************************************************************)
+// Transaltion to js by VB
+// (* Translated to Caml by Xavier Leroy *)
+// (* Original code written in SML by ... *)
+
+//var sys = require('sys');
+
+function arr(size,v) {
+ var t = [];
+ for (var i=0; i < size; i++) t[i] = v;
+ return t;
+}
+
+function arr2(size) {
+ var t = [];
+ for (var i=0; i < size; i++) t[i] = [];
+ return t;
+}
+
+function eval(bdd, vars) {
+ switch (bdd.id) {
+ case 0:
+ return false;
+ case 1:
+ return true;
+ default:
+ return vars[bdd.v]?eval(bdd.h,vars):eval(bdd.l,vars);
+ }
+}
+
+function getId(bdd) { return bdd.id; };
+
+var initSize_1 = 8*1024 - 1;
+var nodeC = 1;
+var sz_1 = initSize_1;
+var htab = arr2(sz_1+1);
+var n_items = 0;
+
+function hashVal(x,y,v) { return ((x << 1) + y + (v << 2)); };
+
+function resize(newSize) {
+ var newSz_1 = newSize-1;
+ var newArr = arr2(newSize);
+ for (var i = 0; i <= sz_1; i++) {
+ var b = htab[i];
+ for (var j = 0; j < b.length; j++) {
+ var n = b[j];
+ var ind = hashVal(getId(n.l), getId(n.h), n.v) & newSz_1;
+ newArr[ind].push(n);
+ }
+ }
+ htab = newArr;
+ sz_1 = newSz_1;
+}
+
+function insert(idl,idh,v,ind,bucket,newNode) {
+ if (n_items <= sz_1) {
+ htab[ind].push(newNode);
+ n_items ++;
+ }
+ else {
+ resize(sz_1 + sz_1 + 2);
+ ind = hashVal(idl,idh,v) & sz_1;
+ htab[ind].push(newNode);
+ };
+};
+
+
+function mkNode(low,v,high) {
+ var idl = getId(low);
+ var idh = getId(high);
+ if (idl == idh) return low; else {
+ var ind = hashVal(idl,idh,v) & sz_1;
+ var bucket = htab[ind];
+ for (i = 0; i < bucket.length; i++) {
+ var n = bucket[i];
+ if ((v == n.v) && (idl == getId(n.l)) && (idh == getId(n.h)))
+ return n;
+ }
+ nodeC ++;
+ var nn = {l:low, v:v, id:nodeC, h:high};
+ insert(getId(low),getId(high),v,ind,bucket,nn);
+ return nn;
+ };
+};
+
+
+function cmpVar(x,y) {
+ if (xy) { return 1; }
+ else return 0;
+};
+
+var zero = {id:0}
+var one = {id:1}
+
+function mkVar(xx) { return mkNode(zero,xx,one); };
+
+var cacheSize = 1999;
+
+var andslot1 = arr(cacheSize,0);
+var andslot2 = arr(cacheSize,0);
+var andslot3 = arr(cacheSize,zero);
+var xorslot1 = arr(cacheSize,0);
+var xorslot2 = arr(cacheSize,0);
+var xorslot3 = arr(cacheSize,zero);
+var notslot1 = arr(cacheSize,0);
+var notslot2 = arr(cacheSize,one);
+
+function hash(x,y) { return (((x << 1)+y) % cacheSize); };
+
+function not(n) {
+ var id = n.id;
+ switch (id) {
+ case 0:
+ return one;
+ case 1:
+ return zero;
+ default:
+ var h = id % cacheSize;
+ if (id == notslot1[h]) {
+ return notslot2[h];
+ } else {
+ var f = mkNode(not(n.l),n.v,not(n.h));
+ notslot1[h] = id;
+ notslot2[h] = f;
+ return f;
+ };
+ };
+};
+
+function and2(n1,n2) {
+ var i1 = n1.id;
+ switch (i1) {
+ case 0:
+ return zero;
+ case 1:
+ return n2;
+ default:
+ var i2 = n2.id;
+ switch (i2) {
+ case 0:
+ return zero;
+ case 1:
+ return n1;
+ default:
+ var h = hash(i1,i2);
+ if ((i1 == andslot1[h]) && (i2 == andslot2[h])) {
+ return andslot3[h];
+ } else {
+ var f;
+ switch (cmpVar(n1.v,n2.v)) {
+ case 0:
+ f = mkNode(and2(n1.l,n2.l),n1.v,and2(n1.h,n2.h));
+ break;
+ case -1:
+ f = mkNode(and2(n1.l,n2),n1.v,and2(n1.h,n2));
+ break;
+ default:
+ f = mkNode(and2(n1,n2.l),n2.v,and2(n1,n2.h));
+ break;
+ };
+ andslot1[h] = i1;
+ andslot2[h] = i2;
+ andslot3[h] = f;
+ return f;
+ }
+ }
+ }
+}
+
+function xor(n1,n2) {
+ var i1 = n1.id;
+ switch (i1) {
+ case 0:
+ return n2;
+ case 1:
+ return not(n2);
+ default:
+ var i2 = n2.id;
+ switch (i2) {
+ case 0:
+ return n1;
+ case 1:
+ return not(n1);
+ default:
+ var h = hash(i1,i2);
+ if ((i1 == andslot1[h]) && (i2 == andslot2[h])) {
+ return andslot3[h];
+ } else {
+ var f;
+ switch (cmpVar(n1.v,n2.v)) {
+ case 0:
+ f = mkNode(xor(n1.l,n2.l),n1.v,xor(n1.h,n2.h));
+ break;
+ case -1:
+ f = mkNode(xor(n1.l,n2),n1.v,xor(n1.h,n2));
+ break;
+ default:
+ f = mkNode(xor(n1,n2.l),n2.v,xor(n1,n2.h));
+ break;
+ };
+ andslot1[h] = i1;
+ andslot2[h] = i2;
+ andslot3[h] = f;
+ return f;
+ }
+ }
+ }
+}
+
+function hwb(n) {
+ function h(i,j) {
+ if (i==j) {
+ return mkVar(i);
+ } else {
+ return xor(and2(not(mkVar(j)),h(i,j-1)),
+ and2(mkVar(j),g(i,j-1)));
+ };
+ };
+ function g(i,j) {
+ if (i==j) {
+ return mkVar(i);
+ } else {
+ return xor(and2(not(mkVar(i)),h(i+1,j)),
+ and2(mkVar(i),g(i+1,j)));
+ };
+ };
+ return h(0,n-1);
+};
+
+/* Testing */
+var seed = 0;
+
+function random() {
+ seed = (seed * 25173 + 17431)|0;
+ return (seed & 1) > 0;
+};
+
+function random_vars(n) {
+ var vars = [];
+ for (var i = 0; i < n; i++) vars[i] = random();
+ return vars;
+};
+
+function test_hwb(bdd,vars) {
+ /* We should have
+ eval bdd vars = vars.(n-1) if n > 0
+ eval bdd vars = false if n = 0
+ where n is the number of "true" elements in vars. */
+ var ntrue = 0;
+ for (var i = 0; i < vars.length; i++) {
+ if (vars[i]) ntrue++;
+ };
+ return (eval(bdd,vars) == ((ntrue > 0) ? vars[ntrue-1] : false))
+};
+
+var n = 22;
+var ntests = 100;
+
+var bdd = hwb(n);
+var succeeded = true;
+
+for (var i = 1; i <= ntests; i++) {
+ succeeded = succeeded && test_hwb(bdd,random_vars(n));
+};
+
+//print(nodeC);
+//if (succeeded) print("ok"); else print("failed");
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/js/bdd_lists.js js-of-ocaml-2.2/benchmarks/sources/js/bdd_lists.js
--- js-of-ocaml-1.4/benchmarks/sources/js/bdd_lists.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/js/bdd_lists.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,287 @@
+// (***********************************************************************)
+// (* *)
+// (* Objective Caml *)
+// (* *)
+// (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+// (* *)
+// (* Copyright 1996 Institut National de Recherche en Informatique et *)
+// (* en Automatique. All rights reserved. This file is distributed *)
+// (* under the terms of the Q Public License version 1.0. *)
+// (* *)
+// (***********************************************************************)
+// Transaltion to js by VB
+// (* Translated to Caml by Xavier Leroy *)
+// (* Original code written in SML by ... *)
+
+//var sys = require('sys');
+
+function arr(size,v) {
+ var t = [];
+ for (var i=0; i < size; i++) t[i] = v;
+ return t;
+}
+
+function eval(bdd, vars) {
+ switch (bdd.id) {
+ case 0:
+ return false;
+ case 1:
+ return true;
+ default:
+ return vars[bdd.v]?eval(bdd.h,vars):eval(bdd.l,vars);
+ }
+}
+
+function getId(bdd) { return bdd.id; };
+
+var initSize_1 = 8*1024 - 1;
+var nodeC = 1;
+var sz_1 = initSize_1;
+var htab = new Array(sz_1+1);
+var n_items = 0;
+
+function hashVal(x,y,v) { return ((x << 1) + y + (v << 2)); };
+
+function resize(newSize) {
+ var arr = htab;
+ var newSz_1 = newSize-1;
+ var newArr = [];
+ function copyBucket(bucket) {
+ if (bucket) {
+ var n = bucket.head;
+ var ind = hashVal(getId(n.l), getId(n.h), n.v) & newSz_1;
+ newArr[ind] = {head: n, tail: newArr[ind]};
+ copyBucket(bucket.tail);
+ };
+ };
+ for (var n = 0; n <= sz_1; n++) {
+ copyBucket(arr[n]);
+ }
+ htab = newArr;
+ sz_1 = newSz_1;
+}
+
+
+function insert(idl,idh,v,ind,bucket,newNode) {
+ if (n_items <= sz_1) {
+ htab[ind] = {head: newNode, tail: bucket};
+ n_items ++;
+ }
+ else {
+ resize(sz_1 + sz_1 + 2);
+ ind = hashVal(idl,idh,v) & sz_1;
+ htab[ind] = {head: newNode, tail: htab[ind]};
+ };
+};
+
+
+function mkNode(low,v,high) {
+ var idl = getId(low);
+ var idh = getId(high);
+ if (idl == idh) return low; else {
+ var ind = hashVal(idl,idh,v) & sz_1;
+ var bucket = htab[ind];
+ function lookup(b) {
+ if (!b) {
+ nodeC ++;
+ var nn = {l:low, v:v, id:nodeC, h:high};
+ insert(getId(low),getId(high),v,ind,bucket,nn);
+ return nn;
+ }
+ else {
+ var n = b.head;
+ if ((v == n.v) && (idl == getId(n.l)) && (idh == getId(n.h))) {
+ return n;
+ } else {
+ return lookup(b.tail);
+ };
+ };
+ };
+ return lookup(bucket);
+ };
+};
+
+
+function cmpVar(x,y) {
+ if (xy) { return 1; }
+ else return 0;
+};
+
+var zero = {id:0}
+var one = {id:1}
+
+function mkVar(xx) { return mkNode(zero,xx,one); };
+
+var cacheSize = 1999;
+
+var andslot1 = arr(cacheSize,0);
+var andslot2 = arr(cacheSize,0);
+var andslot3 = arr(cacheSize,zero);
+var xorslot1 = arr(cacheSize,0);
+var xorslot2 = arr(cacheSize,0);
+var xorslot3 = arr(cacheSize,zero);
+var notslot1 = arr(cacheSize,0);
+var notslot2 = arr(cacheSize,one);
+
+function hash(x,y) { return (((x << 1)+y) % cacheSize); };
+
+function not(n) {
+ var id = n.id;
+ switch (id) {
+ case 0:
+ return one;
+ case 1:
+ return zero;
+ default:
+ var h = id % cacheSize;
+ if (id == notslot1[h]) {
+ return notslot2[h];
+ } else {
+ var f = mkNode(not(n.l),n.v,not(n.h));
+ notslot1[h] = id;
+ notslot2[h] = f;
+ return f;
+ };
+ };
+};
+
+function and2(n1,n2) {
+ var i1 = n1.id;
+ switch (i1) {
+ case 0:
+ return zero;
+ case 1:
+ return n2;
+ default:
+ var i2 = n2.id;
+ switch (i2) {
+ case 0:
+ return zero;
+ case 1:
+ return n1;
+ default:
+ var h = hash(i1,i2);
+ if ((i1 == andslot1[h]) && (i2 == andslot2[h])) {
+ return andslot3[h];
+ } else {
+ var f;
+ switch (cmpVar(n1.v,n2.v)) {
+ case 0:
+ f = mkNode(and2(n1.l,n2.l),n1.v,and2(n1.h,n2.h));
+ break;
+ case -1:
+ f = mkNode(and2(n1.l,n2),n1.v,and2(n1.h,n2));
+ break;
+ default:
+ f = mkNode(and2(n1,n2.l),n2.v,and2(n1,n2.h));
+ break;
+ };
+ andslot1[h] = i1;
+ andslot2[h] = i2;
+ andslot3[h] = f;
+ return f;
+ }
+ }
+ }
+}
+
+function xor(n1,n2) {
+ var i1 = n1.id;
+ switch (i1) {
+ case 0:
+ return n2;
+ case 1:
+ return not(n2);
+ default:
+ var i2 = n2.id;
+ switch (i2) {
+ case 0:
+ return n1;
+ case 1:
+ return not(n1);
+ default:
+ var h = hash(i1,i2);
+ if ((i1 == andslot1[h]) && (i2 == andslot2[h])) {
+ return andslot3[h];
+ } else {
+ var f;
+ switch (cmpVar(n1.v,n2.v)) {
+ case 0:
+ f = mkNode(xor(n1.l,n2.l),n1.v,xor(n1.h,n2.h));
+ break;
+ case -1:
+ f = mkNode(xor(n1.l,n2),n1.v,xor(n1.h,n2));
+ break;
+ default:
+ f = mkNode(xor(n1,n2.l),n2.v,xor(n1,n2.h));
+ break;
+ };
+ andslot1[h] = i1;
+ andslot2[h] = i2;
+ andslot3[h] = f;
+ return f;
+ }
+ }
+ }
+}
+
+function hwb(n) {
+ function h(i,j) {
+ if (i==j) {
+ return mkVar(i);
+ } else {
+ return xor(and2(not(mkVar(j)),h(i,j-1)),
+ and2(mkVar(j),g(i,j-1)));
+ };
+ };
+ function g(i,j) {
+ if (i==j) {
+ return mkVar(i);
+ } else {
+ return xor(and2(not(mkVar(i)),h(i+1,j)),
+ and2(mkVar(i),g(i+1,j)));
+ };
+ };
+ return h(0,n-1);
+};
+
+/* Testing */
+var seed = 0;
+
+function random() {
+ seed = (seed * 25173 + 17431)|0;
+ return (seed & 1) > 0;
+};
+
+function random_vars(n) {
+ var vars = [];
+ for (var i = 0; i < n; i++) vars[i] = random();
+ return vars;
+};
+
+function test_hwb(bdd,vars) {
+ /* We should have
+ eval bdd vars = vars.(n-1) if n > 0
+ eval bdd vars = false if n = 0
+ where n is the number of "true" elements in vars. */
+ var ntrue = 0;
+ for (var i = 0; i < vars.length; i++) {
+ if (vars[i]) ntrue++;
+ };
+ return (eval(bdd,vars) == ((ntrue > 0) ? vars[ntrue-1] : false))
+};
+
+var n = 22;
+var ntests = 100;
+
+var bdd = hwb(n);
+var succeeded = true;
+
+for (var i = 1; i <= ntests; i++) {
+ succeeded = succeeded && test_hwb(bdd,random_vars(n));
+};
+
+//print(nodeC);
+//if (succeeded) print("ok"); else print("failed");
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/js/binary_trees.js js-of-ocaml-2.2/benchmarks/sources/js/binary_trees.js
--- js-of-ocaml-1.4/benchmarks/sources/js/binary_trees.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/js/binary_trees.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,51 @@
+/* The Great Computer Language Shootout
+ http://shootout.alioth.debian.org/
+ contributed by Isaac Gouy */
+
+function TreeNode(left,right,item){
+ this.left = left;
+ this.right = right;
+ this.item = item;
+}
+
+TreeNode.prototype.itemCheck = function(){
+ if (this.left==null) return this.item;
+ else return this.item + this.left.itemCheck() - this.right.itemCheck();
+}
+
+function bottomUpTree(item,depth){
+ if (depth>0){
+ return new TreeNode(
+ bottomUpTree(2*item-1, depth-1)
+ ,bottomUpTree(2*item, depth-1)
+ ,item
+ );
+ }
+ else {
+ return new TreeNode(null,null,item);
+ }
+}
+
+
+var minDepth = 4;
+var n = arguments[0];
+var maxDepth = Math.max(minDepth + 2, n);
+var stretchDepth = maxDepth + 1;
+
+var check = bottomUpTree(0,stretchDepth).itemCheck();
+//print("stretch tree of depth " + stretchDepth + "\t check: " + check);
+
+var longLivedTree = bottomUpTree(0,maxDepth);
+for (var depth=minDepth; depth<=maxDepth; depth+=2){
+ var iterations = 1 << (maxDepth - depth + minDepth);
+
+ check = 0;
+ for (var i=1; i<=iterations; i++){
+ check += bottomUpTree(i,depth).itemCheck();
+ check += bottomUpTree(-i,depth).itemCheck();
+ }
+ // print(iterations*2 + "\t trees of depth " + depth + "\t check: " + check);
+}
+
+//print("long lived tree of depth " + maxDepth + "\t check: "
+// + longLivedTree.itemCheck());
diff -Nru js-of-ocaml-1.4/benchmarks/sources/js/fannkuch_redux.js js-of-ocaml-2.2/benchmarks/sources/js/fannkuch_redux.js
--- js-of-ocaml-1.4/benchmarks/sources/js/fannkuch_redux.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/js/fannkuch_redux.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,51 @@
+/* The Computer Language Benchmarks Game
+ http://shootout.alioth.debian.org/
+
+ contributed by Isaac Gouy, transliterated from Mike Pall's Lua program
+*/
+
+function fannkuch(n) {
+ var p = Array(n), q = Array(n), s = Array(n);
+ var sign = 1, maxflips = 0, sum = 0, m = n-1;
+ for(var i=0; i maxflips) maxflips = flips; // New maximum?
+ break;
+ }
+ q[q0] = q0;
+ if (q0 >= 3){
+ var i = 1, j = q0 - 1, t;
+ do { t = q[i]; q[i] = q[j]; q[j] = t; i++; j--; } while (i < j);
+ }
+ q0 = qq; flips++;
+ } while (true);
+ }
+ // Permute.
+ if (sign == 1){
+ var t = p[1]; p[1] = p[0]; p[0] = t; sign = -1; // Rotate 0<-1.
+ } else {
+ var t = p[1]; p[1] = p[2]; p[2] = t; sign = 1; // Rotate 0<-1 and 0<-1<-2.
+ for(var i=2; i 0.0) ? ( (this.red > 1.0) ? 1.0 : this.red ) : 0.0;
+ this.green = (this.green > 0.0) ? ( (this.green > 1.0) ? 1.0 : this.green ) : 0.0;
+ this.blue = (this.blue > 0.0) ? ( (this.blue > 1.0) ? 1.0 : this.blue ) : 0.0;
+ },
+
+ distance : function(color) {
+ var d = Math.abs(this.red - color.red) + Math.abs(this.green - color.green) + Math.abs(this.blue - color.blue);
+ return d;
+ },
+
+ blend: function(c1, c2, w){
+ var result = new Flog.RayTracer.Color(0,0,0);
+ result = Flog.RayTracer.Color.prototype.add(
+ Flog.RayTracer.Color.prototype.multiplyScalar(c1, 1 - w),
+ Flog.RayTracer.Color.prototype.multiplyScalar(c2, w)
+ );
+ return result;
+ },
+
+ brightness : function() {
+ var r = Math.floor(this.red*255);
+ var g = Math.floor(this.green*255);
+ var b = Math.floor(this.blue*255);
+ return (r * 77 + g * 150 + b * 29) >> 8;
+ },
+
+ toString : function () {
+ var r = Math.floor(this.red*255);
+ var g = Math.floor(this.green*255);
+ var b = Math.floor(this.blue*255);
+
+ return "rgb("+ r +","+ g +","+ b +")";
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Light = Class.create();
+
+Flog.RayTracer.Light.prototype = {
+ position: null,
+ color: null,
+ intensity: 10.0,
+
+ initialize : function(pos, color, intensity) {
+ this.position = pos;
+ this.color = color;
+ this.intensity = (intensity ? intensity : 10.0);
+ },
+
+ toString : function () {
+ return 'Light [' + this.position.x + ',' + this.position.y + ',' + this.position.z + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Vector = Class.create();
+
+Flog.RayTracer.Vector.prototype = {
+ x : 0.0,
+ y : 0.0,
+ z : 0.0,
+
+ initialize : function(x, y, z) {
+ this.x = (x ? x : 0);
+ this.y = (y ? y : 0);
+ this.z = (z ? z : 0);
+ },
+
+ copy: function(vector){
+ this.x = vector.x;
+ this.y = vector.y;
+ this.z = vector.z;
+ },
+
+ normalize : function() {
+ var m = this.magnitude();
+ return new Flog.RayTracer.Vector(this.x / m, this.y / m, this.z / m);
+ },
+
+ magnitude : function() {
+ return Math.sqrt((this.x * this.x) + (this.y * this.y) + (this.z * this.z));
+ },
+
+ cross : function(w) {
+ return new Flog.RayTracer.Vector(
+ -this.z * w.y + this.y * w.z,
+ this.z * w.x - this.x * w.z,
+ -this.y * w.x + this.x * w.y);
+ },
+
+ dot : function(w) {
+ return this.x * w.x + this.y * w.y + this.z * w.z;
+ },
+
+ add : function(v, w) {
+ return new Flog.RayTracer.Vector(w.x + v.x, w.y + v.y, w.z + v.z);
+ },
+
+ subtract : function(v, w) {
+ if(!w || !v) throw 'Vectors must be defined [' + v + ',' + w + ']';
+ return new Flog.RayTracer.Vector(v.x - w.x, v.y - w.y, v.z - w.z);
+ },
+
+ multiplyVector : function(v, w) {
+ return new Flog.RayTracer.Vector(v.x * w.x, v.y * w.y, v.z * w.z);
+ },
+
+ multiplyScalar : function(v, w) {
+ return new Flog.RayTracer.Vector(v.x * w, v.y * w, v.z * w);
+ },
+
+ toString : function () {
+ return 'Vector [' + this.x + ',' + this.y + ',' + this.z + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Ray = Class.create();
+
+Flog.RayTracer.Ray.prototype = {
+ position : null,
+ direction : null,
+ initialize : function(pos, dir) {
+ this.position = pos;
+ this.direction = dir;
+ },
+
+ toString : function () {
+ return 'Ray [' + this.position + ',' + this.direction + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Scene = Class.create();
+
+Flog.RayTracer.Scene.prototype = {
+ camera : null,
+ shapes : [],
+ lights : [],
+ background : null,
+
+ initialize : function() {
+ this.camera = new Flog.RayTracer.Camera(
+ new Flog.RayTracer.Vector(0,0,-5),
+ new Flog.RayTracer.Vector(0,0,1),
+ new Flog.RayTracer.Vector(0,1,0)
+ );
+ this.shapes = new Array();
+ this.lights = new Array();
+ this.background = new Flog.RayTracer.Background(new Flog.RayTracer.Color(0,0,0.5), 0.2);
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+if(typeof(Flog.RayTracer.Material) == 'undefined') Flog.RayTracer.Material = {};
+
+Flog.RayTracer.Material.BaseMaterial = Class.create();
+
+Flog.RayTracer.Material.BaseMaterial.prototype = {
+
+ gloss: 2.0, // [0...infinity] 0 = matt
+ transparency: 0.0, // 0=opaque
+ reflection: 0.0, // [0...infinity] 0 = no reflection
+ refraction: 0.50,
+ hasTexture: false,
+
+ initialize : function() {
+
+ },
+
+ getColor: function(u, v){
+
+ },
+
+ wrapUp: function(t){
+ t = t % 2.0;
+ if(t < -1) t += 2.0;
+ if(t >= 1) t -= 2.0;
+ return t;
+ },
+
+ toString : function () {
+ return 'Material [gloss=' + this.gloss + ', transparency=' + this.transparency + ', hasTexture=' + this.hasTexture +']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Material.Solid = Class.create();
+
+Flog.RayTracer.Material.Solid.prototype = Object.extend(
+ new Flog.RayTracer.Material.BaseMaterial(), {
+ initialize : function(color, reflection, refraction, transparency, gloss) {
+ this.color = color;
+ this.reflection = reflection;
+ this.transparency = transparency;
+ this.gloss = gloss;
+ this.hasTexture = false;
+ },
+
+ getColor: function(u, v){
+ return this.color;
+ },
+
+ toString : function () {
+ return 'SolidMaterial [gloss=' + this.gloss + ', transparency=' + this.transparency + ', hasTexture=' + this.hasTexture +']';
+ }
+ }
+);
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Material.Chessboard = Class.create();
+
+Flog.RayTracer.Material.Chessboard.prototype = Object.extend(
+ new Flog.RayTracer.Material.BaseMaterial(), {
+ colorEven: null,
+ colorOdd: null,
+ density: 0.5,
+
+ initialize : function(colorEven, colorOdd, reflection, transparency, gloss, density) {
+ this.colorEven = colorEven;
+ this.colorOdd = colorOdd;
+ this.reflection = reflection;
+ this.transparency = transparency;
+ this.gloss = gloss;
+ this.density = density;
+ this.hasTexture = true;
+ },
+
+ getColor: function(u, v){
+ var t = this.wrapUp(u * this.density) * this.wrapUp(v * this.density);
+
+ if(t < 0.0)
+ return this.colorEven;
+ else
+ return this.colorOdd;
+ },
+
+ toString : function () {
+ return 'ChessMaterial [gloss=' + this.gloss + ', transparency=' + this.transparency + ', hasTexture=' + this.hasTexture +']';
+ }
+ }
+);
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+if(typeof(Flog.RayTracer.Shape) == 'undefined') Flog.RayTracer.Shape = {};
+
+Flog.RayTracer.Shape.Sphere = Class.create();
+
+Flog.RayTracer.Shape.Sphere.prototype = {
+ initialize : function(pos, radius, material) {
+ this.radius = radius;
+ this.position = pos;
+ this.material = material;
+ },
+
+ intersect: function(ray){
+ var info = new Flog.RayTracer.IntersectionInfo();
+ info.shape = this;
+
+ var dst = Flog.RayTracer.Vector.prototype.subtract(ray.position, this.position);
+
+ var B = dst.dot(ray.direction);
+ var C = dst.dot(dst) - (this.radius * this.radius);
+ var D = (B * B) - C;
+
+ if(D > 0){ // intersection!
+ info.isHit = true;
+ info.distance = (-B) - Math.sqrt(D);
+ info.position = Flog.RayTracer.Vector.prototype.add(
+ ray.position,
+ Flog.RayTracer.Vector.prototype.multiplyScalar(
+ ray.direction,
+ info.distance
+ )
+ );
+ info.normal = Flog.RayTracer.Vector.prototype.subtract(
+ info.position,
+ this.position
+ ).normalize();
+
+ info.color = this.material.getColor(0,0);
+ } else {
+ info.isHit = false;
+ }
+ return info;
+ },
+
+ toString : function () {
+ return 'Sphere [position=' + this.position + ', radius=' + this.radius + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+if(typeof(Flog.RayTracer.Shape) == 'undefined') Flog.RayTracer.Shape = {};
+
+Flog.RayTracer.Shape.Plane = Class.create();
+
+Flog.RayTracer.Shape.Plane.prototype = {
+ d: 0.0,
+
+ initialize : function(pos, d, material) {
+ this.position = pos;
+ this.d = d;
+ this.material = material;
+ },
+
+ intersect: function(ray){
+ var info = new Flog.RayTracer.IntersectionInfo();
+
+ var Vd = this.position.dot(ray.direction);
+ if(Vd == 0) return info; // no intersection
+
+ var t = -(this.position.dot(ray.position) + this.d) / Vd;
+ if(t <= 0) return info;
+
+ info.shape = this;
+ info.isHit = true;
+ info.position = Flog.RayTracer.Vector.prototype.add(
+ ray.position,
+ Flog.RayTracer.Vector.prototype.multiplyScalar(
+ ray.direction,
+ t
+ )
+ );
+ info.normal = this.position;
+ info.distance = t;
+
+ if(this.material.hasTexture){
+ var vU = new Flog.RayTracer.Vector(this.position.y, this.position.z, -this.position.x);
+ var vV = vU.cross(this.position);
+ var u = info.position.dot(vU);
+ var v = info.position.dot(vV);
+ info.color = this.material.getColor(u,v);
+ } else {
+ info.color = this.material.getColor(0,0);
+ }
+
+ return info;
+ },
+
+ toString : function () {
+ return 'Plane [' + this.position + ', d=' + this.d + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.IntersectionInfo = Class.create();
+
+Flog.RayTracer.IntersectionInfo.prototype = {
+ isHit: false,
+ hitCount: 0,
+ shape: null,
+ position: null,
+ normal: null,
+ color: null,
+ distance: null,
+
+ initialize : function() {
+ this.color = new Flog.RayTracer.Color(0,0,0);
+ },
+
+ toString : function () {
+ return 'Intersection [' + this.position + ']';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Camera = Class.create();
+
+Flog.RayTracer.Camera.prototype = {
+ position: null,
+ lookAt: null,
+ equator: null,
+ up: null,
+ screen: null,
+
+ initialize : function(pos, lookAt, up) {
+ this.position = pos;
+ this.lookAt = lookAt;
+ this.up = up;
+ this.equator = lookAt.normalize().cross(this.up);
+ this.screen = Flog.RayTracer.Vector.prototype.add(this.position, this.lookAt);
+ },
+
+ getRay: function(vx, vy){
+ var pos = Flog.RayTracer.Vector.prototype.subtract(
+ this.screen,
+ Flog.RayTracer.Vector.prototype.subtract(
+ Flog.RayTracer.Vector.prototype.multiplyScalar(this.equator, vx),
+ Flog.RayTracer.Vector.prototype.multiplyScalar(this.up, vy)
+ )
+ );
+ pos.y = pos.y * -1;
+ var dir = Flog.RayTracer.Vector.prototype.subtract(
+ pos,
+ this.position
+ );
+
+ var ray = new Flog.RayTracer.Ray(pos, dir.normalize());
+
+ return ray;
+ },
+
+ toString : function () {
+ return 'Ray []';
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Background = Class.create();
+
+Flog.RayTracer.Background.prototype = {
+ color : null,
+ ambience : 0.0,
+
+ initialize : function(color, ambience) {
+ this.color = color;
+ this.ambience = ambience;
+ }
+}
+/* Fake a Flog.* namespace */
+if(typeof(Flog) == 'undefined') var Flog = {};
+if(typeof(Flog.RayTracer) == 'undefined') Flog.RayTracer = {};
+
+Flog.RayTracer.Engine = Class.create();
+
+Flog.RayTracer.Engine.prototype = {
+ canvas: null, /* 2d context we can render to */
+
+ initialize: function(options){
+ this.options = Object.extend({
+ canvasHeight: 100,
+ canvasWidth: 100,
+ pixelWidth: 2,
+ pixelHeight: 2,
+ renderDiffuse: false,
+ renderShadows: false,
+ renderHighlights: false,
+ renderReflections: false,
+ rayDepth: 2
+ }, options || {});
+
+ this.options.canvasHeight /= this.options.pixelHeight;
+ this.options.canvasWidth /= this.options.pixelWidth;
+
+ /* TODO: dynamically include other scripts */
+ },
+
+ setPixel: function(x, y, color){
+ var pxW, pxH;
+ pxW = this.options.pixelWidth;
+ pxH = this.options.pixelHeight;
+
+ if (this.canvas) {
+ this.canvas.fillStyle = color.toString();
+ this.canvas.fillRect (x * pxW, y * pxH, pxW, pxH);
+ } else {
+ if (x === y) {
+ checkNumber += color.brightness();
+ }
+ // print(x * pxW, y * pxH, pxW, pxH);
+ }
+ },
+
+ renderScene: function(scene, canvas){
+ checkNumber = 0;
+ /* Get canvas */
+ if (canvas) {
+ this.canvas = canvas.getContext("2d");
+ } else {
+ this.canvas = null;
+ }
+
+ var canvasHeight = this.options.canvasHeight;
+ var canvasWidth = this.options.canvasWidth;
+
+ for(var y=0; y < canvasHeight; y++){
+ for(var x=0; x < canvasWidth; x++){
+ var yp = y * 1.0 / canvasHeight * 2 - 1;
+ var xp = x * 1.0 / canvasWidth * 2 - 1;
+
+ var ray = scene.camera.getRay(xp, yp);
+
+ var color = this.getPixelColor(ray, scene);
+
+ this.setPixel(x, y, color);
+ }
+ }
+ if (checkNumber !== 2321) {
+ throw new Error("Scene rendered incorrectly");
+ }
+ },
+
+ getPixelColor: function(ray, scene){
+ var info = this.testIntersection(ray, scene, null);
+ if(info.isHit){
+ var color = this.rayTrace(info, ray, scene, 0);
+ return color;
+ }
+ return scene.background.color;
+ },
+
+ testIntersection: function(ray, scene, exclude){
+ var hits = 0;
+ var best = new Flog.RayTracer.IntersectionInfo();
+ best.distance = 2000;
+
+ for(var i=0; i= 0 && info.distance < best.distance){
+ best = info;
+ hits++;
+ }
+ }
+ }
+ best.hitCount = hits;
+ return best;
+ },
+
+ getReflectionRay: function(P,N,V){
+ var c1 = -N.dot(V);
+ var R1 = Flog.RayTracer.Vector.prototype.add(
+ Flog.RayTracer.Vector.prototype.multiplyScalar(N, 2*c1),
+ V
+ );
+ return new Flog.RayTracer.Ray(P, R1);
+ },
+
+ rayTrace: function(info, ray, scene, depth){
+ // Calc ambient
+ var color = Flog.RayTracer.Color.prototype.multiplyScalar(info.color, scene.background.ambience);
+ var oldColor = color;
+ var shininess = Math.pow(10, info.shape.material.gloss + 1);
+
+ for(var i=0; i 0.0){
+ color = Flog.RayTracer.Color.prototype.add(
+ color,
+ Flog.RayTracer.Color.prototype.multiply(
+ info.color,
+ Flog.RayTracer.Color.prototype.multiplyScalar(
+ light.color,
+ L
+ )
+ )
+ );
+ }
+ }
+
+ // The greater the depth the more accurate the colours, but
+ // this is exponentially (!) expensive
+ if(depth <= this.options.rayDepth){
+ // calculate reflection ray
+ if(this.options.renderReflections && info.shape.material.reflection > 0)
+ {
+ var reflectionRay = this.getReflectionRay(info.position, info.normal, ray.direction);
+ var refl = this.testIntersection(reflectionRay, scene, info.shape);
+
+ if (refl.isHit && refl.distance > 0){
+ refl.color = this.rayTrace(refl, reflectionRay, scene, depth + 1);
+ } else {
+ refl.color = scene.background.color;
+ }
+
+ color = Flog.RayTracer.Color.prototype.blend(
+ color,
+ refl.color,
+ info.shape.material.reflection
+ );
+ }
+
+ // Refraction
+ /* TODO */
+ }
+
+ /* Render shadows and highlights */
+
+ var shadowInfo = new Flog.RayTracer.IntersectionInfo();
+
+ if(this.options.renderShadows){
+ var shadowRay = new Flog.RayTracer.Ray(info.position, v);
+
+ shadowInfo = this.testIntersection(shadowRay, scene, info.shape);
+ if(shadowInfo.isHit && shadowInfo.shape != info.shape /*&& shadowInfo.shape.type != 'PLANE'*/){
+ var vA = Flog.RayTracer.Color.prototype.multiplyScalar(color, 0.5);
+ var dB = (0.5 * Math.pow(shadowInfo.shape.material.transparency, 0.5));
+ color = Flog.RayTracer.Color.prototype.addScalar(vA,dB);
+ }
+ }
+
+ // Phong specular highlights
+ if(this.options.renderHighlights && !shadowInfo.isHit && info.shape.material.gloss > 0){
+ var Lv = Flog.RayTracer.Vector.prototype.subtract(
+ info.shape.position,
+ light.position
+ ).normalize();
+
+ var E = Flog.RayTracer.Vector.prototype.subtract(
+ scene.camera.position,
+ info.shape.position
+ ).normalize();
+
+ var H = Flog.RayTracer.Vector.prototype.subtract(
+ E,
+ Lv
+ ).normalize();
+
+ var glossWeight = Math.pow(Math.max(info.normal.dot(H), 0), shininess);
+ color = Flog.RayTracer.Color.prototype.add(
+ Flog.RayTracer.Color.prototype.multiplyScalar(light.color, glossWeight),
+ color
+ );
+ }
+ }
+ color.limit();
+ return color;
+ }
+};
+
+
+function renderScene(){
+ var scene = new Flog.RayTracer.Scene();
+
+ scene.camera = new Flog.RayTracer.Camera(
+ new Flog.RayTracer.Vector(0, 0, -15),
+ new Flog.RayTracer.Vector(-0.2, 0, 5),
+ new Flog.RayTracer.Vector(0, 1, 0)
+ );
+
+ scene.background = new Flog.RayTracer.Background(
+ new Flog.RayTracer.Color(0.5, 0.5, 0.5),
+ 0.4
+ );
+
+ var sphere = new Flog.RayTracer.Shape.Sphere(
+ new Flog.RayTracer.Vector(-1.5, 1.5, 2),
+ 1.5,
+ new Flog.RayTracer.Material.Solid(
+ new Flog.RayTracer.Color(0,0.5,0.5),
+ 0.3,
+ 0.0,
+ 0.0,
+ 2.0
+ )
+ );
+
+ var sphere1 = new Flog.RayTracer.Shape.Sphere(
+ new Flog.RayTracer.Vector(1, 0.25, 1),
+ 0.5,
+ new Flog.RayTracer.Material.Solid(
+ new Flog.RayTracer.Color(0.9,0.9,0.9),
+ 0.1,
+ 0.0,
+ 0.0,
+ 1.5
+ )
+ );
+
+ var plane = new Flog.RayTracer.Shape.Plane(
+ new Flog.RayTracer.Vector(0.1, 0.9, -0.5).normalize(),
+ 1.2,
+ new Flog.RayTracer.Material.Chessboard(
+ new Flog.RayTracer.Color(1,1,1),
+ new Flog.RayTracer.Color(0,0,0),
+ 0.2,
+ 0.0,
+ 1.0,
+ 0.7
+ )
+ );
+
+ scene.shapes.push(plane);
+ scene.shapes.push(sphere);
+ scene.shapes.push(sphere1);
+
+ var light = new Flog.RayTracer.Light(
+ new Flog.RayTracer.Vector(5, 10, -1),
+ new Flog.RayTracer.Color(0.8, 0.8, 0.8)
+ );
+
+ var light1 = new Flog.RayTracer.Light(
+ new Flog.RayTracer.Vector(-3, 5, -15),
+ new Flog.RayTracer.Color(0.8, 0.8, 0.8),
+ 100
+ );
+
+ scene.lights.push(light);
+ scene.lights.push(light1);
+
+ var imageWidth = 100; // $F('imageWidth');
+ var imageHeight = 100; // $F('imageHeight');
+ var pixelSize = "5,5".split(','); // $F('pixelSize').split(',');
+ var renderDiffuse = true; // $F('renderDiffuse');
+ var renderShadows = true; // $F('renderShadows');
+ var renderHighlights = true; // $F('renderHighlights');
+ var renderReflections = true; // $F('renderReflections');
+ var rayDepth = 2;//$F('rayDepth');
+
+ var raytracer = new Flog.RayTracer.Engine(
+ {
+ canvasWidth: imageWidth,
+ canvasHeight: imageHeight,
+ pixelWidth: pixelSize[0],
+ pixelHeight: pixelSize[1],
+ "renderDiffuse": renderDiffuse,
+ "renderHighlights": renderHighlights,
+ "renderShadows": renderShadows,
+ "renderReflections": renderReflections,
+ "rayDepth": rayDepth
+ }
+ );
+
+ raytracer.renderScene(scene, null, 0);
+}
+
+var d = Date.now ();
+for (var i = 1; i <= 100; i++) { renderScene(); };
+print(Date.now() - d);
diff -Nru js-of-ocaml-1.4/benchmarks/sources/js/splay.js js-of-ocaml-2.2/benchmarks/sources/js/splay.js
--- js-of-ocaml-1.4/benchmarks/sources/js/splay.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/js/splay.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,393 @@
+// Copyright 2009 the V8 project authors. All rights reserved.
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are
+// met:
+//
+// * Redistributions of source code must retain the above copyright
+// notice, this list of conditions and the following disclaimer.
+// * Redistributions in binary form must reproduce the above
+// copyright notice, this list of conditions and the following
+// disclaimer in the documentation and/or other materials provided
+// with the distribution.
+// * Neither the name of Google Inc. nor the names of its
+// contributors may be used to endorse or promote products derived
+// from this software without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+// LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+// DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+// THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+// This benchmark is based on a JavaScript log processing module used
+// by the V8 profiler to generate execution time profiles for runs of
+// JavaScript applications, and it effectively measures how fast the
+// JavaScript engine is at allocating nodes and reclaiming the memory
+// used for old nodes. Because of the way splay trees work, the engine
+// also has to deal with a lot of changes to the large tree object
+// graph.
+
+// Configuration.
+var kSplayTreeSize = 8000;
+var kSplayTreeModifications = 80;
+var kSplayTreePayloadDepth = 5;
+
+var splayTree = null;
+
+
+function GeneratePayloadTree(depth, tag) {
+ if (depth == 0) {
+ return {
+ array : [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
+ string : 'String for key ' + tag + ' in leaf node'
+ };
+ } else {
+ return {
+ left: GeneratePayloadTree(depth - 1, tag),
+ right: GeneratePayloadTree(depth - 1, tag)
+ };
+ }
+}
+
+
+function GenerateKey() {
+ // The benchmark framework guarantees that Math.random is
+ // deterministic; see base.js.
+ return Math.random();
+}
+
+
+function InsertNewNode() {
+ // Insert new node with a unique key.
+ var key;
+ do {
+ key = GenerateKey();
+ } while (splayTree.find(key) != null);
+ var payload = GeneratePayloadTree(kSplayTreePayloadDepth, String(key));
+ splayTree.insert(key, payload);
+ return key;
+}
+
+
+
+function SplaySetup() {
+ splayTree = new SplayTree();
+ for (var i = 0; i < kSplayTreeSize; i++) InsertNewNode();
+}
+
+
+function SplayTearDown() {
+ // Allow the garbage collector to reclaim the memory
+ // used by the splay tree no matter how we exit the
+ // tear down function.
+ var keys = splayTree.exportKeys();
+ splayTree = null;
+
+ // Verify that the splay tree has the right size.
+ var length = keys.length;
+ if (length != kSplayTreeSize) {
+ throw new Error("Splay tree has wrong size");
+ }
+
+ // Verify that the splay tree has sorted, unique keys.
+ for (var i = 0; i < length - 1; i++) {
+ if (keys[i] >= keys[i + 1]) {
+ throw new Error("Splay tree not sorted");
+ }
+ }
+}
+
+
+function SplayRun() {
+ // Replace a few nodes in the splay tree.
+ for (var i = 0; i < kSplayTreeModifications; i++) {
+ var key = InsertNewNode();
+ var greatest = splayTree.findGreatestLessThan(key);
+ if (greatest == null) splayTree.remove(key);
+ else splayTree.remove(greatest.key);
+ }
+}
+
+
+/**
+ * Constructs a Splay tree. A splay tree is a self-balancing binary
+ * search tree with the additional property that recently accessed
+ * elements are quick to access again. It performs basic operations
+ * such as insertion, look-up and removal in O(log(n)) amortized time.
+ *
+ * @constructor
+ */
+function SplayTree() {
+};
+
+
+/**
+ * Pointer to the root node of the tree.
+ *
+ * @type {SplayTree.Node}
+ * @private
+ */
+SplayTree.prototype.root_ = null;
+
+
+/**
+ * @return {boolean} Whether the tree is empty.
+ */
+SplayTree.prototype.isEmpty = function() {
+ return !this.root_;
+};
+
+
+/**
+ * Inserts a node into the tree with the specified key and value if
+ * the tree does not already contain a node with the specified key. If
+ * the value is inserted, it becomes the root of the tree.
+ *
+ * @param {number} key Key to insert into the tree.
+ * @param {*} value Value to insert into the tree.
+ */
+SplayTree.prototype.insert = function(key, value) {
+ if (this.isEmpty()) {
+ this.root_ = new SplayTree.Node(key, value);
+ return;
+ }
+ // Splay on the key to move the last node on the search path for
+ // the key to the root of the tree.
+ this.splay_(key);
+ if (this.root_.key == key) {
+ return;
+ }
+ var node = new SplayTree.Node(key, value);
+ if (key > this.root_.key) {
+ node.left = this.root_;
+ node.right = this.root_.right;
+ this.root_.right = null;
+ } else {
+ node.right = this.root_;
+ node.left = this.root_.left;
+ this.root_.left = null;
+ }
+ this.root_ = node;
+};
+
+
+/**
+ * Removes a node with the specified key from the tree if the tree
+ * contains a node with this key. The removed node is returned. If the
+ * key is not found, an exception is thrown.
+ *
+ * @param {number} key Key to find and remove from the tree.
+ * @return {SplayTree.Node} The removed node.
+ */
+SplayTree.prototype.remove = function(key) {
+ if (this.isEmpty()) {
+ throw Error('Key not found: ' + key);
+ }
+ this.splay_(key);
+ if (this.root_.key != key) {
+ throw Error('Key not found: ' + key);
+ }
+ var removed = this.root_;
+ if (!this.root_.left) {
+ this.root_ = this.root_.right;
+ } else {
+ var right = this.root_.right;
+ this.root_ = this.root_.left;
+ // Splay to make sure that the new root has an empty right child.
+ this.splay_(key);
+ // Insert the original right child as the right child of the new
+ // root.
+ this.root_.right = right;
+ }
+ return removed;
+};
+
+
+/**
+ * Returns the node having the specified key or null if the tree doesn't contain
+ * a node with the specified key.
+ *
+ * @param {number} key Key to find in the tree.
+ * @return {SplayTree.Node} Node having the specified key.
+ */
+SplayTree.prototype.find = function(key) {
+ if (this.isEmpty()) {
+ return null;
+ }
+ this.splay_(key);
+ return this.root_.key == key ? this.root_ : null;
+};
+
+
+/**
+ * @return {SplayTree.Node} Node having the maximum key value.
+ */
+SplayTree.prototype.findMax = function(opt_startNode) {
+ if (this.isEmpty()) {
+ return null;
+ }
+ var current = opt_startNode || this.root_;
+ while (current.right) {
+ current = current.right;
+ }
+ return current;
+};
+
+
+/**
+ * @return {SplayTree.Node} Node having the maximum key value that
+ * is less than the specified key value.
+ */
+SplayTree.prototype.findGreatestLessThan = function(key) {
+ if (this.isEmpty()) {
+ return null;
+ }
+ // Splay on the key to move the node with the given key or the last
+ // node on the search path to the top of the tree.
+ this.splay_(key);
+ // Now the result is either the root node or the greatest node in
+ // the left subtree.
+ if (this.root_.key < key) {
+ return this.root_;
+ } else if (this.root_.left) {
+ return this.findMax(this.root_.left);
+ } else {
+ return null;
+ }
+};
+
+
+/**
+ * @return {Array<*>} An array containing all the keys of tree's nodes.
+ */
+SplayTree.prototype.exportKeys = function() {
+ var result = [];
+ if (!this.isEmpty()) {
+ this.root_.traverse_(function(node) { result.push(node.key); });
+ }
+ return result;
+};
+
+
+/**
+ * Perform the splay operation for the given key. Moves the node with
+ * the given key to the top of the tree. If no node has the given
+ * key, the last node on the search path is moved to the top of the
+ * tree. This is the simplified top-down splaying algorithm from:
+ * "Self-adjusting Binary Search Trees" by Sleator and Tarjan
+ *
+ * @param {number} key Key to splay the tree on.
+ * @private
+ */
+SplayTree.prototype.splay_ = function(key) {
+ if (this.isEmpty()) {
+ return;
+ }
+ // Create a dummy node. The use of the dummy node is a bit
+ // counter-intuitive: The right child of the dummy node will hold
+ // the L tree of the algorithm. The left child of the dummy node
+ // will hold the R tree of the algorithm. Using a dummy node, left
+ // and right will always be nodes and we avoid special cases.
+ var dummy, left, right;
+ dummy = left = right = new SplayTree.Node(null, null);
+ var current = this.root_;
+ while (true) {
+ if (key < current.key) {
+ if (!current.left) {
+ break;
+ }
+ if (key < current.left.key) {
+ // Rotate right.
+ var tmp = current.left;
+ current.left = tmp.right;
+ tmp.right = current;
+ current = tmp;
+ if (!current.left) {
+ break;
+ }
+ }
+ // Link right.
+ right.left = current;
+ right = current;
+ current = current.left;
+ } else if (key > current.key) {
+ if (!current.right) {
+ break;
+ }
+ if (key > current.right.key) {
+ // Rotate left.
+ var tmp = current.right;
+ current.right = tmp.left;
+ tmp.left = current;
+ current = tmp;
+ if (!current.right) {
+ break;
+ }
+ }
+ // Link left.
+ left.right = current;
+ left = current;
+ current = current.right;
+ } else {
+ break;
+ }
+ }
+ // Assemble.
+ left.right = current.left;
+ right.left = current.right;
+ current.left = dummy.right;
+ current.right = dummy.left;
+ this.root_ = current;
+};
+
+
+/**
+ * Constructs a Splay tree node.
+ *
+ * @param {number} key Key.
+ * @param {*} value Value.
+ */
+SplayTree.Node = function(key, value) {
+ this.key = key;
+ this.value = value;
+};
+
+
+/**
+ * @type {SplayTree.Node}
+ */
+SplayTree.Node.prototype.left = null;
+
+
+/**
+ * @type {SplayTree.Node}
+ */
+SplayTree.Node.prototype.right = null;
+
+
+/**
+ * Performs an ordered traversal of the subtree starting at
+ * this SplayTree.Node.
+ *
+ * @param {function(SplayTree.Node)} f Visitor function.
+ * @private
+ */
+SplayTree.Node.prototype.traverse_ = function(f) {
+ var current = this;
+ while (current) {
+ var left = current.left;
+ if (left) left.traverse_(f);
+ f(current);
+ current = current.right;
+ }
+};
+
+SplaySetup();
+SplayRun();
+SplayTearDown();
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/almabench.ml js-of-ocaml-2.2/benchmarks/sources/ml/almabench.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/almabench.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/almabench.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,324 @@
+(*
+ * ALMABENCH 1.0.1
+ * Objective Caml version
+ *
+ * A number-crunching benchmark designed for cross-language and vendor
+ * comparisons.
+ *
+ * Written by Shawn Wagner, from Scott Robert Ladd's versions for
+ * C++ and java.
+ *
+ * No rights reserved. This is public domain software, for use by anyone.
+ *
+ * This program calculates the daily ephemeris (at noon) for the years
+ * 2000-2099 using an algorithm developed by J.L. Simon, P. Bretagnon, J.
+ * Chapront, M. Chapront-Touze, G. Francou and J. Laskar of the Bureau des
+ * Longitudes, Paris, France), as detailed in Astronomy & Astrophysics
+ * 282, 663 (1994)
+ *
+ * Note that the code herein is design for the purpose of testing
+ * computational performance; error handling and other such "niceties"
+ * is virtually non-existent.
+ *
+ * Actual (and oft-updated) benchmark results can be found at:
+ * http://www.coyotegulch.com
+ *
+ * Please do not use this information or algorithm in any way that might
+ * upset the balance of the universe or otherwise cause planets to impact
+ * upon one another.
+ *)
+
+let pic = 3.14159265358979323846
+and j2000 = 2451545.0
+and jcentury = 36525.0
+and jmillenia = 365250.0
+
+let twopi = 2.0 *. pic
+and a2r = pic /. 648000.0
+and r2h = 12.0 /. pic
+and r2d = 180.0 /. pic
+and gaussk = 0.01720209895
+
+(* number of days to include in test *)
+let test_loops = 5 (* was: 20 *)
+and test_length = 36525
+
+(* sin and cos of j2000 mean obliquity (iau 1976) *)
+and sineps = 0.3977771559319137
+and coseps = 0.9174820620691818
+
+and amas = [| 6023600.0; 408523.5; 328900.5; 3098710.0; 1047.355; 3498.5; 22869.0; 19314.0 |]
+
+(*
+ * tables giving the mean keplerian elements, limited to t**2 terms:
+ * a semi-major axis (au)
+ * dlm mean longitude (degree and arcsecond)
+ * e eccentricity
+ * pi longitude of the perihelion (degree and arcsecond)
+ * dinc inclination (degree and arcsecond)
+ * omega longitude of the ascending node (degree and arcsecond)
+ *)
+and a = [|
+ [| 0.3870983098; 0.0; 0.0 |];
+ [| 0.7233298200; 0.0; 0.0 |];
+ [| 1.0000010178; 0.0; 0.0 |];
+ [| 1.5236793419; 3e-10; 0.0 |];
+ [| 5.2026032092; 19132e-10; -39e-10 |];
+ [| 9.5549091915; -0.0000213896; 444e-10 |];
+ [| 19.2184460618; -3716e-10; 979e-10 |];
+ [| 30.1103868694; -16635e-10; 686e-10 |] |]
+
+and dlm =
+ [| [| 252.25090552; 5381016286.88982; -1.92789 |];
+ [| 181.97980085; 2106641364.33548; 0.59381 |];
+ [| 100.46645683; 1295977422.83429; -2.04411 |];
+ [| 355.43299958; 689050774.93988; 0.94264 |];
+ [| 34.35151874; 109256603.77991; -30.60378 |];
+ [| 50.07744430; 43996098.55732; 75.61614 |];
+ [| 314.05500511; 15424811.93933; -1.75083 |];
+ [| 304.34866548; 7865503.20744; 0.21103 |] |]
+
+and e =
+ [| [| 0.2056317526; 0.0002040653; -28349e-10 |];
+ [| 0.0067719164; -0.0004776521; 98127e-10 |];
+ [| 0.0167086342; -0.0004203654; -0.0000126734 |];
+ [| 0.0934006477; 0.0009048438; -80641e-10 |];
+ [| 0.0484979255; 0.0016322542; -0.0000471366 |];
+ [| 0.0555481426; -0.0034664062; -0.0000643639 |];
+ [| 0.0463812221; -0.0002729293; 0.0000078913 |];
+ [| 0.0094557470; 0.0000603263; 0.0 |] |]
+
+and pi =
+ [| [| 77.45611904; 5719.11590; -4.83016 |];
+ [| 131.56370300; 175.48640; -498.48184 |];
+ [| 102.93734808; 11612.35290; 53.27577 |];
+ [| 336.06023395; 15980.45908; -62.32800 |];
+ [| 14.33120687; 7758.75163; 259.95938 |];
+ [| 93.05723748; 20395.49439; 190.25952 |];
+ [| 173.00529106; 3215.56238; -34.09288 |];
+ [| 48.12027554; 1050.71912; 27.39717 |] |]
+and dinc =
+ [| [| 7.00498625; -214.25629; 0.28977 |];
+ [| 3.39466189; -30.84437; -11.67836 |];
+ [| 0.0; 469.97289; -3.35053 |];
+ [| 1.84972648; -293.31722; -8.11830 |];
+ [| 1.30326698; -71.55890; 11.95297 |];
+ [| 2.48887878; 91.85195; -17.66225 |];
+ [| 0.77319689; -60.72723; 1.25759 |];
+ [| 1.76995259; 8.12333; 0.08135 |] |]
+
+and omega =
+ [| [| 48.33089304; -4515.21727; -31.79892 |];
+ [| 76.67992019; -10008.48154; -51.32614 |];
+ [| 174.87317577; -8679.27034; 15.34191 |];
+ [| 49.55809321; -10620.90088; -230.57416 |];
+ [| 100.46440702; 6362.03561; 326.52178 |];
+ [| 113.66550252; -9240.19942; -66.23743 |];
+ [| 74.00595701; 2669.15033; 145.93964 |];
+ [| 131.78405702; -221.94322; -0.78728 |] |]
+
+(* tables for trigonometric terms to be added to the mean elements
+ of the semi-major axes. *)
+and kp =
+ [| [| 69613.0; 75645.0; 88306.0; 59899.0; 15746.0; 71087.0; 142173.0; 3086.0; 0.0 |];
+ [| 21863.0; 32794.0; 26934.0; 10931.0; 26250.0; 43725.0; 53867.0; 28939.0; 0.0 |];
+ [| 16002.0; 21863.0; 32004.0; 10931.0; 14529.0; 16368.0; 15318.0; 32794.0; 0.0 |];
+ [| 6345.0; 7818.0; 15636.0; 7077.0; 8184.0; 14163.0; 1107.0; 4872.0; 0.0 |];
+ [| 1760.0; 1454.0; 1167.0; 880.0; 287.0; 2640.0; 19.0; 2047.0; 1454.0 |];
+ [| 574.0; 0.0; 880.0; 287.0; 19.0; 1760.0; 1167.0; 306.0; 574.0 |];
+ [| 204.0; 0.0; 177.0; 1265.0; 4.0; 385.0; 200.0; 208.0; 204.0 |];
+ [| 0.0; 102.0; 106.0; 4.0; 98.0; 1367.0; 487.0; 204.0; 0.0 |] |]
+
+and ca =
+ [| [| 4.0; -13.0; 11.0; -9.0; -9.0; -3.0; -1.0; 4.0; 0.0 |];
+ [| -156.0; 59.0; -42.0; 6.0; 19.0; -20.0; -10.0; -12.0; 0.0 |];
+ [| 64.0; -152.0; 62.0; -8.0; 32.0; -41.0; 19.0; -11.0; 0.0 |];
+ [| 124.0; 621.0; -145.0; 208.0; 54.0; -57.0; 30.0; 15.0; 0.0 |];
+ [| -23437.0; -2634.0; 6601.0; 6259.0; -1507.0; -1821.0; 2620.0; -2115.0;-1489.0 |];
+ [| 62911.0;-119919.0; 79336.0; 17814.0;-24241.0; 12068.0; 8306.0; -4893.0; 8902.0 |];
+ [| 389061.0;-262125.0;-44088.0; 8387.0;-22976.0; -2093.0; -615.0; -9720.0; 6633.0 |];
+ [| -412235.0;-157046.0;-31430.0; 37817.0; -9740.0; -13.0; -7449.0; 9644.0; 0.0 |] |]
+
+and sa =
+ [| [| -29.0; -1.0; 9.0; 6.0; -6.0; 5.0; 4.0; 0.0; 0.0 |];
+ [| -48.0; -125.0; -26.0; -37.0; 18.0; -13.0; -20.0; -2.0; 0.0 |];
+ [| -150.0; -46.0; 68.0; 54.0; 14.0; 24.0; -28.0; 22.0; 0.0 |];
+ [| -621.0; 532.0; -694.0; -20.0; 192.0; -94.0; 71.0; -73.0; 0.0 |];
+ [| -14614.0;-19828.0; -5869.0; 1881.0; -4372.0; -2255.0; 782.0; 930.0; 913.0 |];
+ [| 139737.0; 0.0; 24667.0; 51123.0; -5102.0; 7429.0; -4095.0; -1976.0;-9566.0 |];
+ [| -138081.0; 0.0; 37205.0;-49039.0;-41901.0;-33872.0;-27037.0;-12474.0;18797.0 |];
+ [| 0.0; 28492.0;133236.0; 69654.0; 52322.0;-49577.0;-26430.0; -3593.0; 0.0 |] |]
+
+(* tables giving the trigonometric terms to be added to the mean elements of
+ the mean longitudes . *)
+and kq =
+ [| [| 3086.0; 15746.0; 69613.0; 59899.0; 75645.0; 88306.0; 12661.0; 2658.0; 0.0; 0.0 |];
+ [| 21863.0; 32794.0; 10931.0; 73.0; 4387.0; 26934.0; 1473.0; 2157.0; 0.0; 0.0 |];
+ [| 10.0; 16002.0; 21863.0; 10931.0; 1473.0; 32004.0; 4387.0; 73.0; 0.0; 0.0 |];
+ [| 10.0; 6345.0; 7818.0; 1107.0; 15636.0; 7077.0; 8184.0; 532.0; 10.0; 0.0 |];
+ [| 19.0; 1760.0; 1454.0; 287.0; 1167.0; 880.0; 574.0; 2640.0; 19.0;1454.0 |];
+ [| 19.0; 574.0; 287.0; 306.0; 1760.0; 12.0; 31.0; 38.0; 19.0; 574.0 |];
+ [| 4.0; 204.0; 177.0; 8.0; 31.0; 200.0; 1265.0; 102.0; 4.0; 204.0 |];
+ [| 4.0; 102.0; 106.0; 8.0; 98.0; 1367.0; 487.0; 204.0; 4.0; 102.0 |] |]
+
+and cl =
+ [| [| 21.0; -95.0; -157.0; 41.0; -5.0; 42.0; 23.0; 30.0; 0.0; 0.0 |];
+ [| -160.0; -313.0; -235.0; 60.0; -74.0; -76.0; -27.0; 34.0; 0.0; 0.0 |];
+ [| -325.0; -322.0; -79.0; 232.0; -52.0; 97.0; 55.0; -41.0; 0.0; 0.0 |];
+ [| 2268.0; -979.0; 802.0; 602.0; -668.0; -33.0; 345.0; 201.0; -55.0; 0.0 |];
+ [| 7610.0; -4997.0;-7689.0;-5841.0;-2617.0; 1115.0; -748.0; -607.0; 6074.0; 354.0 |];
+ [| -18549.0; 30125.0;20012.0; -730.0; 824.0; 23.0; 1289.0; -352.0;-14767.0;-2062.0 |];
+ [| -135245.0;-14594.0; 4197.0;-4030.0;-5630.0;-2898.0; 2540.0; -306.0; 2939.0; 1986.0 |];
+ [| 89948.0; 2103.0; 8963.0; 2695.0; 3682.0; 1648.0; 866.0; -154.0; -1963.0; -283.0 |] |]
+
+and sl =
+ [| [| -342.0; 136.0; -23.0; 62.0; 66.0; -52.0; -33.0; 17.0; 0.0; 0.0 |];
+ [| 524.0; -149.0; -35.0; 117.0; 151.0; 122.0; -71.0; -62.0; 0.0; 0.0 |];
+ [| -105.0; -137.0; 258.0; 35.0; -116.0; -88.0; -112.0; -80.0; 0.0; 0.0 |];
+ [| 854.0; -205.0; -936.0; -240.0; 140.0; -341.0; -97.0; -232.0; 536.0; 0.0 |];
+ [| -56980.0; 8016.0; 1012.0; 1448.0;-3024.0;-3710.0; 318.0; 503.0; 3767.0; 577.0 |];
+ [| 138606.0;-13478.0;-4964.0; 1441.0;-1319.0;-1482.0; 427.0; 1236.0; -9167.0;-1918.0 |];
+ [| 71234.0;-41116.0; 5334.0;-4935.0;-1848.0; 66.0; 434.0;-1748.0; 3780.0; -701.0 |];
+ [| -47645.0; 11647.0; 2166.0; 3194.0; 679.0; 0.0; -244.0; -419.0; -2531.0; 48.0 |] |]
+
+
+(* Normalize angle into the range -pi <= A < +pi. *)
+let anpm a =
+ let w = mod_float a twopi in
+ if abs_float w >= pic then begin
+ if a < 0.0 then
+ w +. twopi
+ else
+ w -. twopi
+ end else
+ w
+
+(* The reference frame is equatorial and is with respect to the
+ * mean equator and equinox of epoch j2000. *)
+let planetpv epoch np pv =
+ (* time: julian millennia since j2000. *)
+ let t = ((epoch.(0) -. j2000) +. epoch.(1)) /. jmillenia in
+ (* compute the mean elements. *)
+ let da = ref (a.(np).(0) +. (a.(np).(1) +. a.(np).(2) *. t ) *. t)
+ and dl = ref ((3600.0 *. dlm.(np).(0) +. (dlm.(np).(1) +. dlm.(np).(2) *. t ) *. t) *. a2r)
+ and de = e.(np).(0) +. (e.(np).(1) +. e.(np).(2) *. t ) *. t
+ and dp = anpm ((3600.0 *. pi.(np).(0) +. (pi.(np).(1) +. pi.(np).(2) *. t ) *. t ) *. a2r )
+ and di = (3600.0 *. dinc.(np).(0) +. (dinc.(np).(1) +. dinc.(np).(2) *. t ) *. t ) *. a2r
+ and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )
+ (* apply the trigonometric terms. *)
+ and dmu = 0.35953620 *. t in
+
+ (* loop invariant *)
+ let kp = kp.(np) and kq = kq.(np) and ca = ca.(np) and sa = sa.(np)
+ and cl = cl.(np) and sl = sl.(np) in
+ for k = 0 to 7 do
+ let arga = kp.(k) *. dmu
+ and argl = kq.(k) *. dmu in
+ da := !da +. (ca.(k) *. cos arga +. sa.(k) *. sin arga) *. 0.0000001;
+ dl := !dl +. (cl.(k) *. cos argl +. sl.(k) *. sin argl) *. 0.0000001
+ done;
+ begin let arga = kp.(8) *. dmu in
+ da := !da +. t *. (ca.(8) *. cos arga +. sa.(8) *. sin arga ) *. 0.0000001;
+ for k = 8 to 9 do
+ let argl = kq.(k) *. dmu in
+ dl := !dl +. t *. ( cl.(k) *. cos argl +. sl.(k) *. sin argl ) *. 0.0000001
+ done;
+ end;
+
+
+ dl := mod_float !dl twopi;
+
+ (* iterative solution of kepler's equation to get eccentric anomaly. *)
+ let am = !dl -. dp in
+ let ae = ref (am +. de *. sin am)
+ and k = ref 0 in
+ let dae = ref ((am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae)) in
+ ae := !ae +. !dae;
+ incr k;
+ while !k < 10 || abs_float !dae >= 1e-12 do
+ dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
+ ae := !ae +. !dae;
+ incr k
+ done;
+
+ (* true anomaly. *)
+ let ae2 = !ae /. 2.0 in
+ let at = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2) (cos ae2)
+ (* distance (au) and speed (radians per day). *)
+ and r = !da *. (1.0 -. de *. cos !ae)
+ and v = gaussk *. sqrt ((1.0 +. 1.0 /. amas.(np) ) /. (!da *. !da *. !da))
+ and si2 = sin (di /. 2.0) in
+ let xq = si2 *. cos doh
+ and xp = si2 *. sin doh
+ and tl = at +. dp in
+ let xsw = sin tl
+ and xcw = cos tl in
+ let xm2 = 2.0 *. (xp *. xcw -. xq *. xsw )
+ and xf = !da /. sqrt (1.0 -. de *. de)
+ and ci2 = cos (di /. 2.0) in
+ let xms = (de *. sin dp +. xsw) *. xf
+ and xmc = (de *. cos dp +. xcw) *. xf
+ and xpxq2 = 2.0 *. xp *. xq in
+
+ (* position (j2000 ecliptic x,y,z in au). *)
+ let x = r *. (xcw -. xm2 *. xp)
+ and y = r *. (xsw +. xm2 *. xq)
+ and z = r *. (-.xm2 *. ci2) in
+
+ (* rotate to equatorial. *)
+ pv.(0).(0) <- x;
+ pv.(0).(1) <- y *. coseps -. z *. sineps;
+ pv.(0).(2) <- y *. sineps +. z *. coseps;
+
+ (* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
+ let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
+ and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
+ and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
+
+ (* rotate to equatorial *)
+ pv.(1).(0) <- x;
+ pv.(1).(1) <- y *. coseps -. z *. sineps;
+ pv.(1).(2) <- y *. sineps +. z *. coseps
+
+
+(* Computes RA, Declination, and distance from a state vector returned by
+ * planetpv. *)
+let radecdist state rdd =
+ (* Distance *)
+ rdd.(2) <- sqrt (state.(0).(0) *. state.(0).(0)
+ +. state.(0).(1) *. state.(0).(1)
+ +. state.(0).(2) *. state.(0).(2));
+ (* RA *)
+ rdd.(0) <- atan2 state.(0).(1) state.(0).(0) *. r2h;
+ if rdd.(0) < 0.0 then rdd.(0) <- rdd.(0) +. 24.0;
+
+ (* Declination *)
+ rdd.(1) <- asin (state.(0).(2) /. rdd.(2)) *. r2d
+
+
+
+(* Entry point. Calculate RA and Dec for noon on every day in 1900-2100 *)
+let _ =
+ let jd = [| 0.0; 0.0 |]
+ and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |]
+ and position = [| 0.0; 0.0; 0.0 |] in
+ (* Test *)
+ jd.(0) <- j2000;
+ jd.(1) <- 1.0;
+ for p = 0 to 7 do
+ planetpv jd p pv;
+ radecdist pv position;
+(* Printf.printf "%d %.2f %.2f\n%!" p position.(0) position.(1)*)
+ done;
+ (* Benchmark *)
+ for i = 0 to test_loops - 1 do
+ jd.(0) <- j2000;
+ jd.(1) <- 0.0;
+ for n = 0 to test_length - 1 do
+ jd.(0) <- jd.(0) +. 1.0;
+ for p = 0 to 7 do
+ planetpv jd p pv;
+ radecdist pv position;
+ done
+ done
+ done
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/bdd.ml js-of-ocaml-2.2/benchmarks/sources/ml/bdd.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/bdd.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/bdd.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,235 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: bdd.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(* Translated to Caml by Xavier Leroy *)
+(* Original code written in SML by ... *)
+
+type bdd = One | Zero | Node of bdd * int * int * bdd
+
+let rec eval bdd vars =
+ match bdd with
+ Zero -> false
+ | One -> true
+ | Node(l, v, _, h) ->
+ if vars.(v) then eval h vars else eval l vars
+
+let getId bdd =
+ match bdd with
+ Node(_,_,id,_) -> id
+ | Zero -> 0
+ | One -> 1
+
+let initSize_1 = 8*1024 - 1
+let nodeC = ref 1
+let sz_1 = ref initSize_1
+let htab = ref(Array.create (!sz_1+1) [])
+let n_items = ref 0
+let hashVal x y v = x lsl 1 + y + v lsl 2
+
+let resize newSize =
+ let arr = !htab in
+ let newSz_1 = newSize-1 in
+ let newArr = Array.create newSize [] in
+ let rec copyBucket bucket =
+ match bucket with
+ [] -> ()
+ | n :: ns ->
+ match n with
+ | Node(l,v,_,h) ->
+ let ind = hashVal (getId l) (getId h) v land newSz_1
+ in
+ newArr.(ind) <- (n :: newArr.(ind));
+ copyBucket ns
+ | _ -> assert false
+ in
+ for n = 0 to !sz_1 do
+ copyBucket(arr.(n))
+ done;
+ htab := newArr;
+ sz_1 := newSz_1
+
+
+let rec insert idl idh v ind bucket newNode =
+ if !n_items <= !sz_1
+ then ( (!htab).(ind) <- (newNode :: bucket);
+ incr n_items )
+ else ( resize(!sz_1 + !sz_1 + 2);
+ let ind = hashVal idl idh v land (!sz_1)
+ in
+ (!htab).(ind) <- newNode :: (!htab).(ind)
+ )
+
+
+let resetUnique () = (
+ sz_1 := initSize_1;
+ htab := Array.create (!sz_1+1) [];
+ n_items := 0;
+ nodeC := 1
+ )
+
+let mkNode low v high =
+ let idl = getId low in
+ let idh = getId high
+ in
+ if idl = idh
+ then low
+ else let ind = hashVal idl idh v land (!sz_1) in
+ let bucket = (!htab).(ind) in
+ let rec lookup b =
+ match b with
+ [] -> let n = Node(low, v, (incr nodeC; !nodeC), high)
+ in
+ insert (getId low) (getId high) v ind bucket n; n
+ | n :: ns ->
+ match n with
+ | Node(l,v',id,h) ->
+ if v = v' && idl = getId l && idh = getId h
+ then n else lookup ns
+ | _ -> assert false
+ in
+ lookup bucket
+
+
+type ordering = LESS | EQUAL | GREATER
+
+let cmpVar (x : int) (y : int) =
+ if xy then GREATER else EQUAL
+
+let zero = Zero
+let one = One
+
+let mkVar x = mkNode zero x one
+
+
+let cacheSize = 1999
+let andslot1 = Array.create cacheSize 0
+let andslot2 = Array.create cacheSize 0
+let andslot3 = Array.create cacheSize zero
+let xorslot1 = Array.create cacheSize 0
+let xorslot2 = Array.create cacheSize 0
+let xorslot3 = Array.create cacheSize zero
+let notslot1 = Array.create cacheSize 0
+let notslot2 = Array.create cacheSize one
+let hash x y = ((x lsl 1)+y) mod cacheSize
+
+let rec not n =
+match n with
+ Zero -> One
+| One -> Zero
+| Node(l, v, id, r) -> let h = id mod cacheSize
+ in
+ if id=notslot1.(h) then notslot2.(h)
+ else let f = mkNode (not l) v (not r)
+ in
+ notslot1.(h) <- id; notslot2.(h) <- f; f
+
+let rec and2 n1 n2 =
+match n1 with
+ Node(l1, v1, i1, r1)
+ -> (match n2 with
+ Node(l2, v2, i2, r2)
+ -> let h = hash i1 i2
+ in
+ if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h)
+ else let f = match cmpVar v1 v2 with
+ EQUAL -> mkNode (and2 l1 l2) v1 (and2 r1 r2)
+ | LESS -> mkNode (and2 l1 n2) v1 (and2 r1 n2)
+ | GREATER -> mkNode (and2 n1 l2) v2 (and2 n1 r2)
+ in
+ andslot1.(h) <- i1;
+ andslot2.(h) <- i2;
+ andslot3.(h) <- f;
+ f
+ | Zero -> Zero
+ | One -> n1)
+| Zero -> Zero
+| One -> n2
+
+
+let rec xor n1 n2 =
+match n1 with
+ Node(l1, v1, i1, r1)
+ -> (match n2 with
+ Node(l2, v2, i2, r2)
+ -> let h = hash i1 i2
+ in
+ if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h)
+ else let f = match cmpVar v1 v2 with
+ EQUAL -> mkNode (xor l1 l2) v1 (xor r1 r2)
+ | LESS -> mkNode (xor l1 n2) v1 (xor r1 n2)
+ | GREATER -> mkNode (xor n1 l2) v2 (xor n1 r2)
+ in
+ andslot1.(h) <- i1;
+ andslot2.(h) <- i2;
+ andslot3.(h) <- f;
+ f
+ | Zero -> n1
+ | One -> not n1)
+| Zero -> n2
+| One -> not n2
+
+let hwb n =
+ let rec h i j = if i=j
+ then mkVar i
+ else xor (and2 (not(mkVar j)) (h i (j-1)))
+ (and2 (mkVar j) (g i (j-1)))
+ and g i j = if i=j
+ then mkVar i
+ else xor (and2 (not(mkVar i)) (h (i+1) j))
+ (and2 (mkVar i) (g (i+1) j))
+ in
+ h 0 (n-1)
+
+(* Testing *)
+let seed = ref 0
+
+let random() =
+ seed := !seed * 25173 + 17431; !seed land 1 > 0
+
+let random_vars n =
+ let vars = Array.create n false in
+ for i = 0 to n - 1 do vars.(i) <- random() done;
+ vars
+
+let test_hwb bdd vars =
+ (* We should have
+ eval bdd vars = vars.(n-1) if n > 0
+ eval bdd vars = false if n = 0
+ where n is the number of "true" elements in vars. *)
+ let ntrue = ref 0 in
+ for i = 0 to Array.length vars - 1 do
+ if vars.(i) then incr ntrue
+ done;
+ eval bdd vars = (if !ntrue > 0 then vars.(!ntrue-1) else false)
+
+let main () =
+ let n =
+ if Array.length Sys.argv >= 2 then int_of_string Sys.argv.(1) else 22 in
+ let ntests =
+ if Array.length Sys.argv >= 3 then int_of_string Sys.argv.(2) else 100 in
+ let bdd = hwb n in
+ let succeeded = ref true in
+ for i = 1 to ntests do
+ succeeded := !succeeded && test_hwb bdd (random_vars n)
+ done;
+ assert !succeeded
+(*
+ if !succeeded
+ then print_string "OK\n"
+ else print_string "FAILED\n";
+Format.eprintf "%d@." !nodeC;
+ exit 0
+*)
+
+let _ = main()
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/binary_trees.ml js-of-ocaml-2.2/benchmarks/sources/ml/binary_trees.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/binary_trees.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/binary_trees.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,50 @@
+(* The Computer Language Benchmarks Game
+ * http://shootout.alioth.debian.org/
+ *
+ * Contributed by Troestler Christophe
+ * Modified by Fabrice Le Fessant
+ *)
+
+type 'a tree = Empty | Node of 'a tree * 'a * 'a tree
+
+let rec make i d =
+(* if d = 0 then Empty *)
+ if d = 0 then Node(Empty, i, Empty)
+ else let i2 = 2 * i and d = d - 1 in Node(make (i2 - 1) d, i, make i2 d)
+
+let rec check = function Empty -> 0 | Node(l, i, r) -> i + check l - check r
+
+let min_depth = 4
+let max_depth = (let n = try int_of_string(Array.get Sys.argv 1) with _ -> 10 in
+ max (min_depth + 2) n)
+let stretch_depth = max_depth + 1
+
+let () =
+ (* Gc.set { (Gc.get()) with Gc.minor_heap_size = 1024 * 1024; max_overhead = -1; }; *)
+ let _c = check (make 0 stretch_depth) in
+((*
+ Printf.printf "stretch tree of depth %i\t check: %i\n" stretch_depth c
+ *))
+
+let long_lived_tree = make 0 max_depth
+
+let rec loop_depths d =
+ for i = 0 to ((max_depth - d) / 2 + 1) - 1 do
+ let d = d + i * 2 in
+ let niter = 1 lsl (max_depth - d + min_depth) in
+ let c = ref 0 in
+ for i = 1 to niter do c := !c + check(make i d) + check(make (-i) d) done;
+((*
+ Printf.printf "%i\t trees of depth %i\t check: %i\n" (2 * niter) d !c;
+ *))
+ done
+
+let () =
+(*
+ flush stdout;
+*)
+ loop_depths min_depth;
+((*
+ Printf.printf "long lived tree of depth %i\t check: %i\n"
+ max_depth (check long_lived_tree)
+ *))
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/boyer.ml js-of-ocaml-2.2/benchmarks/sources/ml/boyer.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/boyer.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/boyer.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,914 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: boyer.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(* Manipulations over terms *)
+
+type term =
+ Var of int
+ | Prop of head * term list
+and head =
+ { name: string;
+ mutable props: (term * term) list }
+
+let rec print_term = function
+ Var v ->
+ print_string "v"; print_int v
+ | Prop (head,argl) ->
+ print_string "(";
+ print_string head.name;
+ List.iter (fun t -> print_string " "; print_term t) argl;
+ print_string ")"
+
+let lemmas = ref ([] : head list)
+
+(* Replacement for property lists *)
+
+let get name =
+ let rec get_rec = function
+ hd1::hdl ->
+ if hd1.name = name then hd1 else get_rec hdl
+ | [] ->
+ let entry = {name = name; props = []} in
+ lemmas := entry :: !lemmas;
+ entry
+ in get_rec !lemmas
+
+let add_lemma = function
+ | Prop(_, [(Prop(headl,_) as left); right]) ->
+ headl.props <- (left, right) :: headl.props
+ | _ -> assert false
+
+(* Substitutions *)
+
+type subst = Bind of int * term
+
+let get_binding v list =
+ let rec get_rec = function
+ [] -> failwith "unbound"
+ | Bind(w,t)::rest -> if v = w then t else get_rec rest
+ in get_rec list
+
+let apply_subst alist term =
+ let rec as_rec = function
+ Var v -> begin try get_binding v alist with Failure _ -> term end
+ | Prop (head,argl) -> Prop (head, List.map as_rec argl)
+ in as_rec term
+
+exception Unify
+
+let rec unify term1 term2 =
+ unify1 term1 term2 []
+
+and unify1 term1 term2 unify_subst =
+ match term2 with
+ Var v ->
+ begin try
+ if get_binding v unify_subst = term1
+ then unify_subst
+ else raise Unify
+ with Failure _ ->
+ Bind(v,term1) :: unify_subst
+ end
+ | Prop (head2, argl2) ->
+ match term1 with
+ Var _ -> raise Unify
+ | Prop (head1,argl1) ->
+ if head1 == head2
+ then unify1_lst argl1 argl2 unify_subst
+ else raise Unify
+
+and unify1_lst l1 l2 unify_subst =
+ match (l1, l2) with
+ ([], []) -> unify_subst
+ | (h1::r1, h2::r2) -> unify1_lst r1 r2 (unify1 h1 h2 unify_subst)
+ | _ -> raise Unify
+
+
+let rec rewrite = function
+ Var _ as term -> term
+ | Prop (head, argl) ->
+ rewrite_with_lemmas (Prop (head, List.map rewrite argl)) head.props
+and rewrite_with_lemmas term lemmas =
+ match lemmas with
+ [] ->
+ term
+ | (t1,t2)::rest ->
+ try
+ rewrite (apply_subst (unify term t1) t2)
+ with Unify ->
+ rewrite_with_lemmas term rest
+
+type cterm = CVar of int | CProp of string * cterm list
+
+let rec cterm_to_term = function
+ CVar v -> Var v
+ | CProp(p, l) -> Prop(get p, List.map cterm_to_term l)
+
+let add t = add_lemma (cterm_to_term t)
+
+let _ =
+add (CProp
+("equal",
+ [CProp ("compile",[CVar 5]);
+ CProp
+ ("reverse",
+ [CProp ("codegen",[CProp ("optimize",[CVar 5]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("eqp",[CVar 23; CVar 24]);
+ CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("gt",[CVar 23; CVar 24]); CProp ("lt",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("le",[CVar 23; CVar 24]); CProp ("ge",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]); CProp ("le",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("boolean",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("true",[])]);
+ CProp ("equal",[CVar 23; CProp ("false",[])])])]));
+add (CProp
+("equal",
+ [CProp ("iff",[CVar 23; CVar 24]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 23; CVar 24]);
+ CProp ("implies",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("even1",[CVar 23]);
+ CProp
+ ("if",
+ [CProp ("zerop",[CVar 23]); CProp ("true",[]);
+ CProp ("odd",[CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("countps_",[CVar 11; CVar 15]);
+ CProp ("countps_loop",[CVar 11; CVar 15; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("fact_",[CVar 8]);
+ CProp ("fact_loop",[CVar 8; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("reverse_",[CVar 23]);
+ CProp ("reverse_loop",[CVar 23; CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("divides",[CVar 23; CVar 24]);
+ CProp ("zerop",[CProp ("remainder",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("assume_true",[CVar 21; CVar 0]);
+ CProp ("cons",[CProp ("cons",[CVar 21; CProp ("true",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("assume_false",[CVar 21; CVar 0]);
+ CProp ("cons",[CProp ("cons",[CVar 21; CProp ("false",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("tautology_checker",[CVar 23]);
+ CProp ("tautologyp",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("falsify",[CVar 23]);
+ CProp ("falsify1",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("prime",[CVar 23]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 23])]);
+ CProp
+ ("not",
+ [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
+ CProp ("prime1",[CVar 23; CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("and",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("or",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15; CProp ("true",[]);
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("not",[CVar 15]);
+ CProp ("if",[CVar 15; CProp ("false",[]); CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("implies",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("fix",[CVar 23]);
+ CProp ("if",[CProp ("numberp",[CVar 23]); CVar 23; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
+ CProp
+ ("if",
+ [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
+ CProp ("if",[CVar 2; CVar 3; CVar 4])])]));
+add (CProp
+("equal",
+ [CProp ("zerop",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp ("not",[CProp ("numberp",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("plus",[CVar 23; CProp ("plus",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
+ CProp ("and",[CProp ("zerop",[CVar 0]); CProp ("zerop",[CVar 1])])]));
+add (CProp
+("equal",[CProp ("difference",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
+ CProp ("equal",[CProp ("fix",[CVar 1]); CProp ("fix",[CVar 2])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
+ CProp ("not",[CProp ("gt",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp ("zerop",[CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
+ CProp
+ ("plus",
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
+ CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
+ CProp ("fix",[CProp ("meaning",[CVar 23; CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("append",[CVar 23; CProp ("append",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("append",[CProp ("reverse",[CVar 1]); CProp ("reverse",[CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
+ CProp
+ ("plus",
+ [CProp ("times",[CVar 23; CVar 24]);
+ CProp ("times",[CVar 23; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("times",[CVar 23; CProp ("times",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ CProp ("or",[CProp ("zerop",[CVar 23]); CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
+ CProp
+ ("exec",[CVar 24; CProp ("exec",[CVar 23; CVar 15; CVar 4]); CVar 4])]));
+add (CProp
+("equal",
+ [CProp ("mc_flatten",[CVar 23; CVar 24]);
+ CProp ("append",[CProp ("flatten",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("or",
+ [CProp ("member",[CVar 23; CVar 0]);
+ CProp ("member",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
+ CProp ("member",[CVar 23; CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("length",[CProp ("reverse",[CVar 23])]);
+ CProp ("length",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
+ CProp
+ ("and",
+ [CProp ("member",[CVar 0; CVar 1]); CProp ("member",[CVar 0; CVar 2])])]));
+add (CProp
+("equal",[CProp ("nth",[CProp ("zero",[]); CVar 8]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
+ CProp
+ ("times",
+ [CProp ("exp",[CVar 8; CVar 9]); CProp ("exp",[CVar 8; CVar 10])])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
+ CProp ("exp",[CProp ("exp",[CVar 8; CVar 9]); CVar 10])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CVar 24]);
+ CProp ("append",[CProp ("reverse",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
+ CProp ("reverse",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
+ CProp
+ ("plus",
+ [CProp ("count_list",[CVar 25; CVar 23]);
+ CProp ("count_list",[CVar 25; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
+ CProp ("equal",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+ ("plus",
+ [CProp ("remainder",[CVar 23; CVar 24]);
+ CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
+ CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
+ CProp ("plus",[CProp ("power_eval",[CVar 11; CVar 1]); CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",
+ [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
+ CProp
+ ("plus",
+ [CVar 8;
+ CProp
+ ("plus",
+ [CProp ("power_eval",[CVar 23; CVar 1]);
+ CProp ("power_eval",[CVar 24; CVar 1])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CVar 24; CProp ("one",[])]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
+ CProp ("not",[CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",[CProp ("remainder",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 8])]);
+ CProp
+ ("or",
+ [CProp ("zerop",[CVar 9]);
+ CProp ("not",[CProp ("equal",[CVar 9; CProp ("one",[])])])])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 24])]);
+ CProp ("not",[CProp ("zerop",[CVar 23])]);
+ CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
+ CProp ("fix",[CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",
+ [CProp
+ ("big_plus",
+ [CProp ("power_rep",[CVar 8; CVar 1]);
+ CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
+ CVar 1]);
+ CVar 1]);
+ CProp ("plus",[CVar 8; CVar 9])]));
+add (CProp
+("equal",
+ [CProp ("gcd",[CVar 23; CVar 24]); CProp ("gcd",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
+ CProp
+ ("append",
+ [CProp ("nth",[CVar 0; CVar 8]);
+ CProp
+ ("nth",
+ [CVar 1; CProp ("difference",[CVar 8; CProp ("length",[CVar 0])])])])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
+ CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
+ CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ CProp ("difference",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
+ CProp
+ ("difference",
+ [CProp ("times",[CVar 2; CVar 23]);
+ CProp ("times",[CVar 22; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
+ CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
+ CProp ("plus",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
+ CProp ("add1",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ CProp ("lt",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 25])]);
+ CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("not",[CProp ("zerop",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+ ("gcd",
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
+ CProp ("times",[CVar 25; CProp ("gcd",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
+ CProp ("value",[CVar 23; CVar 0])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("flatten",[CVar 23]);
+ CProp ("cons",[CVar 24; CProp ("nil",[])])]);
+ CProp
+ ("and",
+ [CProp ("nlistp",[CVar 23]); CProp ("equal",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("listp",[CProp ("gother",[CVar 23])]);
+ CProp ("listp",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("samefringe",[CVar 23; CVar 24]);
+ CProp
+ ("equal",[CProp ("flatten",[CVar 23]); CProp ("flatten",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ CProp
+ ("and",
+ [CProp
+ ("or",
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ CProp ("equal",[CVar 23; CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
+ CProp ("equal",[CVar 23; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
+ CProp
+ ("not",
+ [CProp
+ ("and",
+ [CProp
+ ("or",
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ CProp ("not",[CProp ("numberp",[CVar 23])])])])]));
+add (CProp
+("equal",
+ [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
+ CProp
+ ("times",
+ [CProp ("times_list",[CVar 23]); CProp ("times_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
+ CProp
+ ("and",
+ [CProp ("prime_list",[CVar 23]); CProp ("prime_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 25]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 25; CProp ("zero",[])]);
+ CProp ("equal",[CVar 22; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 23]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
+ CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
+ CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
+ CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
+ CProp ("equal",[CProp ("sub1",[CVar 1]); CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
+ CProp ("length",[CVar 11])]);
+ CProp ("member",[CVar 23; CVar 11])]));
+add (CProp
+("equal",
+ [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
+ CProp ("delete",[CVar 23; CProp ("sort2",[CVar 11])])]));
+add (CProp ("equal",[CProp ("dsort",[CVar 23]); CProp ("sort2",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("length",
+ [CProp
+ ("cons",
+ [CVar 0;
+ CProp
+ ("cons",
+ [CVar 1;
+ CProp
+ ("cons",
+ [CVar 2;
+ CProp
+ ("cons",
+ [CVar 3;
+ CProp ("cons",[CVar 4; CProp ("cons",[CVar 5; CVar 6])])])])])])])
+ ; CProp ("plus",[CProp ("six",[]); CProp ("length",[CVar 6])])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
+ CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("quotient",
+ [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("two",[])]);
+ CProp
+ ("plus",[CVar 23; CProp ("quotient",[CVar 24; CProp ("two",[])])])]));
+add (CProp
+("equal",
+ [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
+ CProp
+ ("quotient",
+ [CProp ("times",[CVar 8; CProp ("add1",[CVar 8])]); CProp ("two",[])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("numberp",[CVar 24]);
+ CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("add1",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("difference",[CVar 23; CVar 24]);
+ CProp ("difference",[CVar 25; CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 25; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
+ CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 25])])])])])
+);
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
+ CProp
+ ("if",
+ [CProp ("member",[CVar 23; CVar 24]);
+ CProp
+ ("difference",
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
+ CProp ("meaning",[CVar 23; CVar 0])]);
+ CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("numberp",[CVar 24]);
+ CProp
+ ("plus",
+ [CVar 23; CProp ("times",[CVar 23; CVar 24]);
+ CProp ("fix",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("nil",[]); CVar 8]);
+ CProp
+ ("if",[CProp ("zerop",[CVar 8]); CProp ("nil",[]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 0]);
+ CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
+ CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("equal",[CProp ("true",[]); CVar 25]);
+ CProp ("equal",[CProp ("false",[]); CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("if",
+ [CProp ("assignedp",[CVar 23; CVar 0]);
+ CProp ("assignment",[CVar 23; CVar 0]);
+ CProp ("assignment",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("car",[CProp ("gother",[CVar 23])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 23]);
+ CProp ("car",[CProp ("flatten",[CVar 23])]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 23]);
+ CProp ("cdr",[CProp ("flatten",[CVar 23])]);
+ CProp ("cons",[CProp ("zero",[]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ CProp
+ ("if",
+ [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
+ CProp ("fix",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
+ CProp
+ ("if",
+ [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
+ CProp ("get",[CVar 9; CVar 12])])]))
+
+(* Tautology checker *)
+
+let truep x lst =
+ match x with
+ Prop(head, _) ->
+ head.name = "true" || List.mem x lst
+ | _ ->
+ List.mem x lst
+
+and falsep x lst =
+ match x with
+ Prop(head, _) ->
+ head.name = "false" || List.mem x lst
+ | _ ->
+ List.mem x lst
+
+
+let rec tautologyp x true_lst false_lst =
+ if truep x true_lst then true else
+ if falsep x false_lst then false else begin
+(*
+ print_term x; print_newline();
+*)
+ match x with
+ Var _ -> false
+ | Prop (head,[test; yes; no]) ->
+ if head.name = "if" then
+ if truep test true_lst then
+ tautologyp yes true_lst false_lst
+ else if falsep test false_lst then
+ tautologyp no true_lst false_lst
+ else tautologyp yes (test::true_lst) false_lst &&
+ tautologyp no true_lst (test::false_lst)
+ else
+ false
+ | _ -> assert false
+ end
+
+
+let tautp x =
+(* print_term x; print_string"\n"; *)
+ let y = rewrite x in
+(* print_term y; print_string "\n"; *)
+ tautologyp y [] []
+
+(* the benchmark *)
+
+let subst =
+[Bind(23, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("plus",
+ [CProp ("plus",[CVar 0; CVar 1]);
+ CProp ("plus",[CVar 2; CProp ("zero",[])])])])));
+ Bind(24, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("times",
+ [CProp ("times",[CVar 0; CVar 1]);
+ CProp ("plus",[CVar 2; CVar 3])])])));
+ Bind(25, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("reverse",
+ [CProp
+ ("append",
+ [CProp ("append",[CVar 0; CVar 1]);
+ CProp ("nil",[])])])])));
+ Bind(20, cterm_to_term(
+ CProp
+ ("equal",
+ [CProp ("plus",[CVar 0; CVar 1]);
+ CProp ("difference",[CVar 23; CVar 24])])));
+ Bind(22, cterm_to_term(
+ CProp
+ ("lt",
+ [CProp ("remainder",[CVar 0; CVar 1]);
+ CProp ("member",[CVar 0; CProp ("length",[CVar 1])])])))]
+
+let term = cterm_to_term(
+ CProp
+ ("implies",
+ [CProp
+ ("and",
+ [CProp ("implies",[CVar 23; CVar 24]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 24; CVar 25]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 25; CVar 20]);
+ CProp ("implies",[CVar 20; CVar 22])])])]);
+ CProp ("implies",[CVar 23; CVar 22])]))
+
+let _ =
+ let ok = ref true in
+ for i = 1 to 50 do
+ if not (tautp (apply_subst subst term)) then ok := false
+ done;
+ assert !ok;
+(*
+ if !ok then
+ print_string "Proved!\n"
+ else
+ print_string "Cannot prove!\n";
+ exit 0
+*)
+
+(*********
+with
+ failure s ->
+ print_string "Exception failure("; print_string s; print_string ")\n"
+ | Unify ->
+ print_string "Exception Unify\n"
+ | match_failure(file,start,stop) ->
+ print_string "Exception match_failure(";
+ print_string file;
+ print_string ",";
+ print_int start;
+ print_string ",";
+ print_int stop;
+ print_string ")\n"
+ | _ ->
+ print_string "Exception ?\n"
+
+**********)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/boyer_no_exc.ml js-of-ocaml-2.2/benchmarks/sources/ml/boyer_no_exc.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/boyer_no_exc.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/boyer_no_exc.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,921 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: boyer.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(* Manipulations over terms *)
+
+type term =
+ Var of int
+ | Prop of head * term list
+and head =
+ { name: string;
+ mutable props: (term * term) list }
+
+let rec print_term = function
+ Var v ->
+ print_string "v"; print_int v
+ | Prop (head,argl) ->
+ print_string "(";
+ print_string head.name;
+ List.iter (fun t -> print_string " "; print_term t) argl;
+ print_string ")"
+
+let lemmas = ref ([] : head list)
+
+(* Replacement for property lists *)
+
+let get name =
+ let rec get_rec = function
+ hd1::hdl ->
+ if hd1.name = name then hd1 else get_rec hdl
+ | [] ->
+ let entry = {name = name; props = []} in
+ lemmas := entry :: !lemmas;
+ entry
+ in get_rec !lemmas
+
+let add_lemma = function
+ | Prop(_, [(Prop(headl,_) as left); right]) ->
+ headl.props <- (left, right) :: headl.props
+ | _ -> assert false
+
+(* Substitutions *)
+
+type subst = Bind of int * term
+
+let get_binding v list =
+ let rec get_rec = function
+ [] -> None
+ | Bind(w,t)::rest -> if v = w then Some t else get_rec rest
+ in get_rec list
+
+let apply_subst alist term =
+ let rec as_rec = function
+ Var v ->
+ begin match get_binding v alist with Some t -> t | None -> term end
+ | Prop (head,argl) -> Prop (head, List.map as_rec argl)
+ in as_rec term
+
+exception Unify
+
+let rec unify term1 term2 =
+ unify1 term1 term2 []
+
+and unify1 term1 term2 unify_subst =
+ match term2 with
+ Var v ->
+ begin match get_binding v unify_subst with
+ Some t when t = term1 ->
+ Some unify_subst
+ | Some _ ->
+ None
+ | None ->
+ Some (Bind(v,term1) :: unify_subst)
+ end
+ | Prop (head2, argl2) ->
+ match term1 with
+ Var _ -> None
+ | Prop (head1,argl1) ->
+ if head1 == head2
+ then unify1_lst argl1 argl2 unify_subst
+ else None
+
+and unify1_lst l1 l2 unify_subst =
+ match (l1, l2) with
+ ([], []) -> Some unify_subst
+ | (h1::r1, h2::r2) ->
+ begin match unify1 h1 h2 unify_subst with
+ Some unify_subst -> unify1_lst r1 r2 unify_subst
+ | None -> None
+ end
+ | _ -> None
+
+
+let rec rewrite = function
+ Var _ as term -> term
+ | Prop (head, argl) ->
+ rewrite_with_lemmas (Prop (head, List.map rewrite argl)) head.props
+and rewrite_with_lemmas term lemmas =
+ match lemmas with
+ [] ->
+ term
+ | (t1,t2)::rest ->
+ match unify term t1 with
+ Some unify_subst ->
+ rewrite (apply_subst unify_subst t2)
+ | None ->
+ rewrite_with_lemmas term rest
+
+type cterm = CVar of int | CProp of string * cterm list
+
+let rec cterm_to_term = function
+ CVar v -> Var v
+ | CProp(p, l) -> Prop(get p, List.map cterm_to_term l)
+
+let add t = add_lemma (cterm_to_term t)
+
+let _ =
+add (CProp
+("equal",
+ [CProp ("compile",[CVar 5]);
+ CProp
+ ("reverse",
+ [CProp ("codegen",[CProp ("optimize",[CVar 5]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("eqp",[CVar 23; CVar 24]);
+ CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("gt",[CVar 23; CVar 24]); CProp ("lt",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("le",[CVar 23; CVar 24]); CProp ("ge",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]); CProp ("le",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("boolean",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("true",[])]);
+ CProp ("equal",[CVar 23; CProp ("false",[])])])]));
+add (CProp
+("equal",
+ [CProp ("iff",[CVar 23; CVar 24]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 23; CVar 24]);
+ CProp ("implies",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("even1",[CVar 23]);
+ CProp
+ ("if",
+ [CProp ("zerop",[CVar 23]); CProp ("true",[]);
+ CProp ("odd",[CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("countps_",[CVar 11; CVar 15]);
+ CProp ("countps_loop",[CVar 11; CVar 15; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("fact_",[CVar 8]);
+ CProp ("fact_loop",[CVar 8; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("reverse_",[CVar 23]);
+ CProp ("reverse_loop",[CVar 23; CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("divides",[CVar 23; CVar 24]);
+ CProp ("zerop",[CProp ("remainder",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("assume_true",[CVar 21; CVar 0]);
+ CProp ("cons",[CProp ("cons",[CVar 21; CProp ("true",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("assume_false",[CVar 21; CVar 0]);
+ CProp ("cons",[CProp ("cons",[CVar 21; CProp ("false",[])]); CVar 0])]));
+add (CProp
+("equal",
+ [CProp ("tautology_checker",[CVar 23]);
+ CProp ("tautologyp",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("falsify",[CVar 23]);
+ CProp ("falsify1",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
+add (CProp
+("equal",
+ [CProp ("prime",[CVar 23]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 23])]);
+ CProp
+ ("not",
+ [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
+ CProp ("prime1",[CVar 23; CProp ("sub1",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("and",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("or",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15; CProp ("true",[]);
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("false",[])])]));
+add (CProp
+("equal",
+ [CProp ("not",[CVar 15]);
+ CProp ("if",[CVar 15; CProp ("false",[]); CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("implies",[CVar 15; CVar 16]);
+ CProp
+ ("if",
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ CProp ("true",[])])]));
+add (CProp
+("equal",
+ [CProp ("fix",[CVar 23]);
+ CProp ("if",[CProp ("numberp",[CVar 23]); CVar 23; CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
+ CProp
+ ("if",
+ [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
+ CProp ("if",[CVar 2; CVar 3; CVar 4])])]));
+add (CProp
+("equal",
+ [CProp ("zerop",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp ("not",[CProp ("numberp",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("plus",[CVar 23; CProp ("plus",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
+ CProp ("and",[CProp ("zerop",[CVar 0]); CProp ("zerop",[CVar 1])])]));
+add (CProp
+("equal",[CProp ("difference",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
+ CProp ("equal",[CProp ("fix",[CVar 1]); CProp ("fix",[CVar 2])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
+ CProp ("not",[CProp ("gt",[CVar 24; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 23]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp ("zerop",[CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
+ CProp
+ ("plus",
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
+ CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
+ CProp ("fix",[CProp ("meaning",[CVar 23; CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("append",[CVar 23; CProp ("append",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("append",[CProp ("reverse",[CVar 1]); CProp ("reverse",[CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
+ CProp
+ ("plus",
+ [CProp ("times",[CVar 23; CVar 24]);
+ CProp ("times",[CVar 23; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
+ CProp ("times",[CVar 23; CProp ("times",[CVar 24; CVar 25])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ CProp ("or",[CProp ("zerop",[CVar 23]); CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
+ CProp
+ ("exec",[CVar 24; CProp ("exec",[CVar 23; CVar 15; CVar 4]); CVar 4])]));
+add (CProp
+("equal",
+ [CProp ("mc_flatten",[CVar 23; CVar 24]);
+ CProp ("append",[CProp ("flatten",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("or",
+ [CProp ("member",[CVar 23; CVar 0]);
+ CProp ("member",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
+ CProp ("member",[CVar 23; CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("length",[CProp ("reverse",[CVar 23])]);
+ CProp ("length",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
+ CProp
+ ("and",
+ [CProp ("member",[CVar 0; CVar 1]); CProp ("member",[CVar 0; CVar 2])])]));
+add (CProp
+("equal",[CProp ("nth",[CProp ("zero",[]); CVar 8]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
+ CProp
+ ("times",
+ [CProp ("exp",[CVar 8; CVar 9]); CProp ("exp",[CVar 8; CVar 10])])]));
+add (CProp
+("equal",
+ [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
+ CProp ("exp",[CProp ("exp",[CVar 8; CVar 9]); CVar 10])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CVar 24]);
+ CProp ("append",[CProp ("reverse",[CVar 23]); CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
+ CProp ("reverse",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
+ CProp
+ ("plus",
+ [CProp ("count_list",[CVar 25; CVar 23]);
+ CProp ("count_list",[CVar 25; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
+ CProp ("equal",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+ ("plus",
+ [CProp ("remainder",[CVar 23; CVar 24]);
+ CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
+ CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
+ CProp ("plus",[CProp ("power_eval",[CVar 11; CVar 1]); CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",
+ [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
+ CProp
+ ("plus",
+ [CVar 8;
+ CProp
+ ("plus",
+ [CProp ("power_eval",[CVar 23; CVar 1]);
+ CProp ("power_eval",[CVar 24; CVar 1])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CVar 24; CProp ("one",[])]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
+ CProp ("not",[CProp ("zerop",[CVar 24])])]));
+add (CProp
+("equal",[CProp ("remainder",[CVar 23; CVar 23]); CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 8])]);
+ CProp
+ ("or",
+ [CProp ("zerop",[CVar 9]);
+ CProp ("not",[CProp ("equal",[CVar 9; CProp ("one",[])])])])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 24])]);
+ CProp ("not",[CProp ("zerop",[CVar 23])]);
+ CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])])]));
+add (CProp
+("equal",
+ [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
+ CProp ("fix",[CVar 8])]));
+add (CProp
+("equal",
+ [CProp
+ ("power_eval",
+ [CProp
+ ("big_plus",
+ [CProp ("power_rep",[CVar 8; CVar 1]);
+ CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
+ CVar 1]);
+ CVar 1]);
+ CProp ("plus",[CVar 8; CVar 9])]));
+add (CProp
+("equal",
+ [CProp ("gcd",[CVar 23; CVar 24]); CProp ("gcd",[CVar 24; CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
+ CProp
+ ("append",
+ [CProp ("nth",[CVar 0; CVar 8]);
+ CProp
+ ("nth",
+ [CVar 1; CProp ("difference",[CVar 8; CProp ("length",[CVar 0])])])])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
+ CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
+ CProp ("fix",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ CProp ("difference",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
+ CProp
+ ("difference",
+ [CProp ("times",[CVar 2; CVar 23]);
+ CProp ("times",[CVar 22; CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
+ CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
+ CProp ("plus",[CVar 1; CVar 2])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
+ CProp ("add1",[CVar 24])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ CProp ("lt",[CVar 24; CVar 25])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("zerop",[CVar 25])]);
+ CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("not",[CProp ("zerop",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+ ("gcd",
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
+ CProp ("times",[CVar 25; CProp ("gcd",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
+ CProp ("value",[CVar 23; CVar 0])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("flatten",[CVar 23]);
+ CProp ("cons",[CVar 24; CProp ("nil",[])])]);
+ CProp
+ ("and",
+ [CProp ("nlistp",[CVar 23]); CProp ("equal",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("listp",[CProp ("gother",[CVar 23])]);
+ CProp ("listp",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp ("samefringe",[CVar 23; CVar 24]);
+ CProp
+ ("equal",[CProp ("flatten",[CVar 23]); CProp ("flatten",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ CProp
+ ("and",
+ [CProp
+ ("or",
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ CProp ("equal",[CVar 23; CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
+ CProp ("equal",[CVar 23; CProp ("one",[])])]));
+add (CProp
+("equal",
+ [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
+ CProp
+ ("not",
+ [CProp
+ ("and",
+ [CProp
+ ("or",
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ CProp ("not",[CProp ("numberp",[CVar 23])])])])]));
+add (CProp
+("equal",
+ [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
+ CProp
+ ("times",
+ [CProp ("times_list",[CVar 23]); CProp ("times_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
+ CProp
+ ("and",
+ [CProp ("prime_list",[CVar 23]); CProp ("prime_list",[CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 25]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 25; CProp ("zero",[])]);
+ CProp ("equal",[CVar 22; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("ge",[CVar 23; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
+ CProp
+ ("or",
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ CProp
+ ("and",
+ [CProp ("numberp",[CVar 23]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])])])]));
+add (CProp
+("equal",
+ [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ CProp ("zero",[])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
+ CProp
+ ("and",
+ [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
+ CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
+ CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
+ CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
+ CProp ("equal",[CProp ("sub1",[CVar 1]); CProp ("zero",[])])])]));
+add (CProp
+("equal",
+ [CProp
+ ("lt",
+ [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
+ CProp ("length",[CVar 11])]);
+ CProp ("member",[CVar 23; CVar 11])]));
+add (CProp
+("equal",
+ [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
+ CProp ("delete",[CVar 23; CProp ("sort2",[CVar 11])])]));
+add (CProp ("equal",[CProp ("dsort",[CVar 23]); CProp ("sort2",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("length",
+ [CProp
+ ("cons",
+ [CVar 0;
+ CProp
+ ("cons",
+ [CVar 1;
+ CProp
+ ("cons",
+ [CVar 2;
+ CProp
+ ("cons",
+ [CVar 3;
+ CProp ("cons",[CVar 4; CProp ("cons",[CVar 5; CVar 6])])])])])])])
+ ; CProp ("plus",[CProp ("six",[]); CProp ("length",[CVar 6])])]));
+add (CProp
+("equal",
+ [CProp
+ ("difference",
+ [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
+ CProp ("fix",[CVar 23])]));
+add (CProp
+("equal",
+ [CProp
+ ("quotient",
+ [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("two",[])]);
+ CProp
+ ("plus",[CVar 23; CProp ("quotient",[CVar 24; CProp ("two",[])])])]));
+add (CProp
+("equal",
+ [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
+ CProp
+ ("quotient",
+ [CProp ("times",[CVar 8; CProp ("add1",[CVar 8])]); CProp ("two",[])])]));
+add (CProp
+("equal",
+ [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("numberp",[CVar 24]);
+ CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("add1",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp
+ ("equal",
+ [CProp ("difference",[CVar 23; CVar 24]);
+ CProp ("difference",[CVar 25; CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 25; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
+ CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 25])])])])])
+);
+add (CProp
+("equal",
+ [CProp
+ ("meaning",
+ [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
+ CProp
+ ("if",
+ [CProp ("member",[CVar 23; CVar 24]);
+ CProp
+ ("difference",
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
+ CProp ("meaning",[CVar 23; CVar 0])]);
+ CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
+add (CProp
+("equal",
+ [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
+ CProp
+ ("if",
+ [CProp ("numberp",[CVar 24]);
+ CProp
+ ("plus",
+ [CVar 23; CProp ("times",[CVar 23; CVar 24]);
+ CProp ("fix",[CVar 23])])])]));
+add (CProp
+("equal",
+ [CProp ("nth",[CProp ("nil",[]); CVar 8]);
+ CProp
+ ("if",[CProp ("zerop",[CVar 8]); CProp ("nil",[]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 0]);
+ CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
+ CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
+ CProp
+ ("if",
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("equal",[CProp ("true",[]); CVar 25]);
+ CProp ("equal",[CProp ("false",[]); CVar 25])])]));
+add (CProp
+("equal",
+ [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ CProp
+ ("if",
+ [CProp ("assignedp",[CVar 23; CVar 0]);
+ CProp ("assignment",[CVar 23; CVar 0]);
+ CProp ("assignment",[CVar 23; CVar 1])])]));
+add (CProp
+("equal",
+ [CProp ("car",[CProp ("gother",[CVar 23])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 23]);
+ CProp ("car",[CProp ("flatten",[CVar 23])]); CProp ("zero",[])])]));
+add (CProp
+("equal",
+ [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
+ CProp
+ ("if",
+ [CProp ("listp",[CVar 23]);
+ CProp ("cdr",[CProp ("flatten",[CVar 23])]);
+ CProp ("cons",[CProp ("zero",[]); CProp ("nil",[])])])]));
+add (CProp
+("equal",
+ [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ CProp
+ ("if",
+ [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
+ CProp ("fix",[CVar 23])])]));
+add (CProp
+("equal",
+ [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
+ CProp
+ ("if",
+ [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
+ CProp ("get",[CVar 9; CVar 12])])]))
+
+(* Tautology checker *)
+
+let truep x lst =
+ match x with
+ Prop(head, _) ->
+ head.name = "true" || List.mem x lst
+ | _ ->
+ List.mem x lst
+
+and falsep x lst =
+ match x with
+ Prop(head, _) ->
+ head.name = "false" || List.mem x lst
+ | _ ->
+ List.mem x lst
+
+
+let rec tautologyp x true_lst false_lst =
+ if truep x true_lst then true else
+ if falsep x false_lst then false else begin
+(*
+ print_term x; print_newline();
+*)
+ match x with
+ Var _ -> false
+ | Prop (head,[test; yes; no]) ->
+ if head.name = "if" then
+ if truep test true_lst then
+ tautologyp yes true_lst false_lst
+ else if falsep test false_lst then
+ tautologyp no true_lst false_lst
+ else tautologyp yes (test::true_lst) false_lst &&
+ tautologyp no true_lst (test::false_lst)
+ else
+ false
+ | _ -> assert false
+ end
+
+
+let tautp x =
+(* print_term x; print_string"\n"; *)
+ let y = rewrite x in
+(* print_term y; print_string "\n"; *)
+ tautologyp y [] []
+
+(* the benchmark *)
+
+let subst =
+[Bind(23, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("plus",
+ [CProp ("plus",[CVar 0; CVar 1]);
+ CProp ("plus",[CVar 2; CProp ("zero",[])])])])));
+ Bind(24, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("times",
+ [CProp ("times",[CVar 0; CVar 1]);
+ CProp ("plus",[CVar 2; CVar 3])])])));
+ Bind(25, cterm_to_term(
+ CProp
+ ("f",
+ [CProp
+ ("reverse",
+ [CProp
+ ("append",
+ [CProp ("append",[CVar 0; CVar 1]);
+ CProp ("nil",[])])])])));
+ Bind(20, cterm_to_term(
+ CProp
+ ("equal",
+ [CProp ("plus",[CVar 0; CVar 1]);
+ CProp ("difference",[CVar 23; CVar 24])])));
+ Bind(22, cterm_to_term(
+ CProp
+ ("lt",
+ [CProp ("remainder",[CVar 0; CVar 1]);
+ CProp ("member",[CVar 0; CProp ("length",[CVar 1])])])))]
+
+let term = cterm_to_term(
+ CProp
+ ("implies",
+ [CProp
+ ("and",
+ [CProp ("implies",[CVar 23; CVar 24]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 24; CVar 25]);
+ CProp
+ ("and",
+ [CProp ("implies",[CVar 25; CVar 20]);
+ CProp ("implies",[CVar 20; CVar 22])])])]);
+ CProp ("implies",[CVar 23; CVar 22])]))
+
+let _ =
+ let ok = ref true in
+ for i = 1 to 50 do
+ if not (tautp (apply_subst subst term)) then ok := false
+ done;
+ assert !ok;
+(*
+ if !ok then
+ print_string "Proved!\n"
+ else
+ print_string "Cannot prove!\n";
+ exit 0
+*)
+
+(*********
+with
+ failure s ->
+ print_string "Exception failure("; print_string s; print_string ")\n"
+ | Unify ->
+ print_string "Exception Unify\n"
+ | match_failure(file,start,stop) ->
+ print_string "Exception match_failure(";
+ print_string file;
+ print_string ",";
+ print_int start;
+ print_string ",";
+ print_int stop;
+ print_string ")\n"
+ | _ ->
+ print_string "Exception ?\n"
+
+**********)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/fannkuch_redux_2.ml js-of-ocaml-2.2/benchmarks/sources/ml/fannkuch_redux_2.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/fannkuch_redux_2.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/fannkuch_redux_2.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,74 @@
+(* The Computer Language Benchmarks Game
+ http://shootout.alioth.debian.org/
+
+ contributed by Isaac Gouy, transliterated from Mike Pall's Lua program
+*)
+
+let fannkuch n =
+ let p = Array.create n 0 in
+ let q = Array.create n 0 in
+ let s = Array.create n 0 in
+ let sign = ref 1 in
+ let maxflips = ref 0 in
+ let sum = ref 0 in
+ for i = 0 to n - 1 do
+ p.(i) <- i; q.(i) <- i; s.(i) <- i
+ done;
+ while true do
+ let q0 = ref p.(0) in
+ if !q0 <> 0 then begin
+ for i = 1 to n - 1 do
+ q.(i) <- p.(i)
+ done;
+ let flips = ref 1 in
+ while
+ let qq = q.(!q0) in
+ if qq = 0 then begin
+ sum := !sum + !sign * !flips;
+ if !flips > !maxflips then maxflips := !flips;
+ false
+ end else
+ true
+ do
+ let qq = q.(!q0) in
+ q.(!q0) <- !q0;
+ if !q0 >= 3 then begin
+ let i = ref 1 in
+ let j = ref (!q0 - 1) in
+ while
+ let t = q.(!i) in
+ q.(!i) <- q.(!j); q.(!j) <- t;
+ incr i;
+ decr j;
+ !i < !j
+ do () done
+ end;
+ q0 := qq; incr flips
+ done
+ end;
+ if !sign = 1 then begin
+ let t = p.(1) in p.(1) <- p.(0); p.(0) <- t; sign := -1
+ end else begin
+ let t = p.(1) in p.(1) <- p.(2); p.(2) <- t; sign := 1;
+ try
+ for i = 2 to n - 1 do
+ let sx = s.(i) in
+ if sx <> 0 then begin s.(i) <- sx - 1; raise Exit end;
+ if i = n - 1 then begin
+ Format.eprintf "%d %d@." !sum !maxflips; exit 0
+ end;
+ s.(i) <- i;
+ let t = p.(0) in
+ for j = 0 to i do p.(j) <- p.(j + 1) done;
+ p.(i + 1) <- t
+ done
+ with Exit ->
+ ()
+ end
+ done
+
+let n = 10
+let pf = fannkuch n
+(*
+//print(pf[0] + "\n" + "Pfannkuchen(" + n + ") = " + pf[1]);
+*)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/fannkuch_redux.ml js-of-ocaml-2.2/benchmarks/sources/ml/fannkuch_redux.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/fannkuch_redux.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/fannkuch_redux.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,67 @@
+(* The Computer Language Benchmarks Game
+ http://shootout.alioth.debian.org/
+
+ from Scala version by Otto Bommer, August 2010
+*)
+
+let fannkuch n =
+ begin
+ let perm1 = Array.create n 0 in for i = 0 to (n-1) do perm1.(i) <- i done;
+ let perm = Array.create n 0 in
+ let count = Array.create n 0 in
+ let flips = ref 0
+ and maxflips = ref 0
+ and checksum = ref 0
+ and nperm = ref 0
+ and r = ref n in
+ while !r > 0 do
+(* Printf.printf "perm="; i := 0; while !i < n do Printf.printf "%d " perm1.(!i); i := !i +1; done; Printf.printf "\n"; *)
+ for i = 0 to n-1 do perm.(i) <- perm1.(i) done;
+
+ while !r != 1 do count.(!r-1) <- !r; r := !r - 1; done;
+
+ flips := 0;
+ let k = ref perm.(0) in
+ while !k != 0 do
+ let t = ref 0 in
+ for i = 0 to !k / 2 do
+ t := perm.(i);
+ perm.(i) <- perm.(!k - i);
+ perm.(!k - i) <- !t;
+ done;
+
+ k := perm.(0);
+ flips := !flips + 1;
+ done;
+
+ maxflips := max !maxflips !flips;
+ checksum := !checksum + !flips * (1 - (!nperm land 1) lsl 1);
+
+ let go = ref true in
+ let t = ref 0 in
+ while !go do
+ if !r == n then begin go := false; r := 0; end
+ else
+ begin
+ t := perm1.(0);
+ for i = 0 to !r - 1 do perm1.(i) <- perm1.(i+1) done;
+ perm1.(!r) <- !t;
+
+ count.(!r) <- count.(!r) - 1;
+ if count.(!r) > 0 then go := false
+ else r := !r + 1;
+ end
+ done;
+
+ incr nperm;
+ done;
+
+ (!maxflips, !checksum);
+ end
+
+let _ =
+ let n = 10 in
+ let (_maxflips, _checksum) = fannkuch n in
+((*
+ Printf.printf "%d\nPfannkuchen(%d) = %d\n" checksum n maxflips
+ *))
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/fft.ml js-of-ocaml-2.2/benchmarks/sources/ml/fft.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/fft.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/fft.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,192 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: fft.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+let pi = 3.14159265358979323846
+
+let tpi = 2.0 *. pi
+
+let fft px py np =
+ let i = ref 2 in
+ let m = ref 1 in
+
+ while (!i < np) do
+ i := !i + !i;
+ m := !m + 1
+ done;
+
+ let n = !i in
+
+ if n <> np then begin
+ for i = np+1 to n do
+ px.(i) <- 0.0;
+ py.(i) <- 0.0
+ done;
+(*
+ print_string "Use "; print_int n;
+ print_string " point fft"; print_newline()
+*)
+ end;
+
+ let n2 = ref(n+n) in
+ for k = 1 to !m-1 do
+ n2 := !n2 / 2;
+ let n4 = !n2 / 4 in
+ let e = tpi /. float !n2 in
+
+ for j = 1 to n4 do
+ let a = e *. float(j - 1) in
+ let a3 = 3.0 *. a in
+ let cc1 = cos(a) in
+ let ss1 = sin(a) in
+ let cc3 = cos(a3) in
+ let ss3 = sin(a3) in
+ let is = ref j in
+ let id = ref(2 * !n2) in
+
+ while !is < n do
+ let i0r = ref !is in
+ while !i0r < n do
+ let i0 = !i0r in
+ let i1 = i0 + n4 in
+ let i2 = i1 + n4 in
+ let i3 = i2 + n4 in
+ let r1 = px.(i0) -. px.(i2) in
+ px.(i0) <- px.(i0) +. px.(i2);
+ let r2 = px.(i1) -. px.(i3) in
+ px.(i1) <- px.(i1) +. px.(i3);
+ let s1 = py.(i0) -. py.(i2) in
+ py.(i0) <- py.(i0) +. py.(i2);
+ let s2 = py.(i1) -. py.(i3) in
+ py.(i1) <- py.(i1) +. py.(i3);
+ let s3 = r1 -. s2 in
+ let r1 = r1 +. s2 in
+ let s2 = r2 -. s1 in
+ let r2 = r2 +. s1 in
+ px.(i2) <- r1*.cc1 -. s2*.ss1;
+ py.(i2) <- -.s2*.cc1 -. r1*.ss1;
+ px.(i3) <- s3*.cc3 +. r2*.ss3;
+ py.(i3) <- r2*.cc3 -. s3*.ss3;
+ i0r := i0 + !id
+ done;
+ is := 2 * !id - !n2 + j;
+ id := 4 * !id
+ done
+ done
+ done;
+
+(************************************)
+(* Last stage, length=2 butterfly *)
+(************************************)
+
+ let is = ref 1 in
+ let id = ref 4 in
+
+ while !is < n do
+ let i0r = ref !is in
+ while !i0r <= n do
+ let i0 = !i0r in
+ let i1 = i0 + 1 in
+ let r1 = px.(i0) in
+ px.(i0) <- r1 +. px.(i1);
+ px.(i1) <- r1 -. px.(i1);
+ let r1 = py.(i0) in
+ py.(i0) <- r1 +. py.(i1);
+ py.(i1) <- r1 -. py.(i1);
+ i0r := i0 + !id
+ done;
+ is := 2 * !id - 1;
+ id := 4 * !id
+ done;
+
+(*************************)
+(* Bit reverse counter *)
+(*************************)
+
+ let j = ref 1 in
+
+ for i = 1 to n - 1 do
+ if i < !j then begin
+ let xt = px.(!j) in
+ px.(!j) <- px.(i);
+ px.(i) <- xt;
+ let xt = py.(!j) in
+ py.(!j) <- py.(i);
+ py.(i) <- xt
+ end;
+ let k = ref(n / 2) in
+ while !k < !j do
+ j := !j - !k;
+ k := !k / 2
+ done;
+ j := !j + !k
+ done;
+
+ n
+
+
+let test np =
+(* print_int np; print_string "... "; flush stdout;*)
+ let enp = float np in
+ let npm = np / 2 - 1 in
+ let pxr = Array.create (np+2) 0.0
+ and pxi = Array.create (np+2) 0.0 in
+ let t = pi /. enp in
+ pxr.(1) <- (enp -. 1.0) *. 0.5;
+ pxi.(1) <- 0.0;
+ let n2 = np / 2 in
+ pxr.(n2+1) <- -0.5;
+ pxi.(n2+1) <- 0.0;
+
+ for i = 1 to npm do
+ let j = np - i in
+ pxr.(i+1) <- -0.5;
+ pxr.(j+1) <- -0.5;
+ let z = t *. float i in
+ let y = -0.5*.(cos(z)/.sin(z)) in
+ pxi.(i+1) <- y;
+ pxi.(j+1) <- -.y
+ done;
+(**
+ print_newline();
+ for i=0 to 15 do Printf.printf "%d %f %f\n" i pxr.(i+1) pxi.(i+1) done;
+**)
+ let _ = fft pxr pxi np in
+(**
+ for i=0 to 15 do Printf.printf "%d %f %f\n" i pxr.(i+1) pxi.(i+1) done;
+**)
+ let zr = ref 0.0 in
+ let zi = ref 0.0 in
+ let kr = ref 0 in
+ let ki = ref 0 in
+ for i = 0 to np-1 do
+ let a = abs_float(pxr.(i+1) -. float i) in
+ if !zr < a then begin
+ zr := a;
+ kr := i
+ end;
+ let a = abs_float(pxi.(i+1)) in
+ if !zi < a then begin
+ zi := a;
+ ki := i
+ end
+ done;
+(*print !zr; print !zi;*)
+ if abs_float !zr <= 1e-8 && abs_float !zi <= 1e-8
+ then ((*print_string "ok"*))
+ else assert false(*print_string "ERROR"*);
+((* print_newline()*))
+
+let _ =
+ let np = ref 16 in for i = 1 to 16 do test !np; np := !np*2 done
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/fib.ml js-of-ocaml-2.2/benchmarks/sources/ml/fib.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/fib.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/fib.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,25 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: fib.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+let rec fib n =
+ if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let _ =
+ let n = 40 in
+(*
+ if Array.length Sys.argv >= 2
+ then int_of_string Sys.argv.(1)
+ else 40 in
+*)
+ assert (fib n = 165580141) (*; print_newline(); exit 0*)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/hamming.ml js-of-ocaml-2.2/benchmarks/sources/ml/hamming.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/hamming.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/hamming.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,107 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Damien Doligez, projet Moscova, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2002 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: hamming.ml 4303 2002-01-23 17:50:20Z doligez $ *)
+
+(* We cannot use bignums because we don't do custom runtimes, but
+ int64 is a bit short, so we roll our own 37-digit numbers...
+*)
+
+let n0 = Int64.of_int 0;;
+let n1 = Int64.of_int 1;;
+let n2 = Int64.of_int 2;;
+let n3 = Int64.of_int 3;;
+let n5 = Int64.of_int 5;;
+
+let ( % ) = Int64.rem;;
+let ( * ) = Int64.mul;;
+let ( / ) = Int64.div;;
+let ( + ) = Int64.add;;
+let digit = Int64.of_string "1000000000000000000";;
+
+let mul n (pl, ph) = ((n * pl) % digit, n * ph + (n * pl) / digit);;
+let cmp (nl, nh) (pl, ph) =
+ if nh < ph then -1
+ else if nh > ph then 1
+ else if nl < pl then -1
+ else if nl > pl then 1
+ else 0
+;;
+
+let x2 = fun p -> mul n2 p;;
+let x3 = fun p -> mul n3 p;;
+let x5 = fun p -> mul n5 p;;
+
+let nn1 = (n1, n0);;
+
+let pr (nl, nh) =
+((*
+ if compare nh n0 = 0
+ then Printf.printf "%Ld\n" nl
+ else Printf.printf "%Ld%018Ld\n" nh nl
+ *))
+;;
+
+(*
+ (* bignum version *)
+open Num;;
+let nn1 = num_of_int 1;;
+let x2 = fun p -> (num_of_int 2) */ p;;
+let x3 = fun p -> (num_of_int 3) */ p;;
+let x5 = fun p -> (num_of_int 5) */ p;;
+let cmp n p = sign_num (n -/ p);;
+let pr n = Printf.printf "%s\n" (string_of_num n);;
+*)
+
+
+(* This is where the interesting stuff begins. *)
+
+open Lazy;;
+
+type 'a lcons = Cons of 'a * 'a lcons Lazy.t;;
+type 'a llist = 'a lcons Lazy.t;;
+
+let rec map f l =
+ lazy (
+ match force l with
+ | Cons (x, ll) -> Cons (f x, map f ll)
+ )
+;;
+
+let rec merge cmp l1 l2 =
+ lazy (
+ match force l1, force l2 with
+ | Cons (x1, ll1), Cons (x2, ll2)
+ -> let c = cmp x1 x2 in
+ if c = 0
+ then Cons (x1, merge cmp ll1 ll2)
+ else if c < 0
+ then Cons (x1, merge cmp ll1 l2)
+ else Cons (x2, merge cmp l1 ll2)
+ )
+;;
+
+let rec iter_interval f l (start, stop) =
+ if stop = 0 then ()
+ else match force l with
+ | Cons (x, ll)
+ -> if start <= 0 then f x;
+ iter_interval f ll (start-1, stop-1)
+;;
+
+let rec hamming = lazy (Cons (nn1, merge cmp ham2 (merge cmp ham3 ham5)))
+ and ham2 = lazy (force (map x2 hamming))
+ and ham3 = lazy (force (map x3 hamming))
+ and ham5 = lazy (force (map x5 hamming))
+;;
+
+iter_interval pr hamming (88000, 88100);;
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/kb.ml js-of-ocaml-2.2/benchmarks/sources/ml/kb.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/kb.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/kb.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,590 @@
+let print_string _ = ()
+let print_int _ = ()
+let print_newline _ = ()
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: terms.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(****************** Term manipulations *****************)
+
+type term =
+ Var of int
+ | Term of string * term list
+
+let rec union l1 l2 =
+ match l1 with
+ [] -> l2
+ | a::r -> if List.mem a l2 then union r l2 else a :: union r l2
+
+
+let rec vars = function
+ Var n -> [n]
+ | Term(_,l) -> vars_of_list l
+and vars_of_list = function
+ [] -> []
+ | t::r -> union (vars t) (vars_of_list r)
+
+
+let rec substitute subst = function
+ Term(oper,sons) -> Term(oper, List.map (substitute subst) sons)
+ | Var(n) as t -> try List.assoc n subst with Not_found -> t
+
+
+(* Term replacement: replace M u N is M[u<-N]. *)
+
+let rec replace m u n =
+ match (u, m) with
+ [], _ -> n
+ | i::u, Term(oper, sons) -> Term(oper, replace_nth i sons u n)
+ | _ -> failwith "replace"
+
+and replace_nth i sons u n =
+ match sons with
+ s::r -> if i = 1
+ then replace s u n :: r
+ else s :: replace_nth (i-1) r u n
+ | [] -> failwith "replace_nth"
+
+
+(* Term matching. *)
+
+let matching term1 term2 =
+ let rec match_rec subst t1 t2 =
+ match (t1, t2) with
+ Var v, _ ->
+ if List.mem_assoc v subst then
+ if t2 = List.assoc v subst then subst else failwith "matching"
+ else
+ (v, t2) :: subst
+ | Term(op1,sons1), Term(op2,sons2) ->
+ if op1 = op2
+ then List.fold_left2 match_rec subst sons1 sons2
+ else failwith "matching"
+ | _ -> failwith "matching" in
+ match_rec [] term1 term2
+
+
+(* A naive unification algorithm. *)
+
+let compsubst subst1 subst2 =
+ (List.map (fun (v,t) -> (v, substitute subst1 t)) subst2) @ subst1
+
+
+let rec occurs n = function
+ Var m -> m = n
+ | Term(_,sons) -> List.exists (occurs n) sons
+
+
+let rec unify term1 term2 =
+ match (term1, term2) with
+ Var n1, _ ->
+ if term1 = term2 then []
+ else if occurs n1 term2 then failwith "unify"
+ else [n1, term2]
+ | term1, Var n2 ->
+ if occurs n2 term1 then failwith "unify"
+ else [n2, term1]
+ | Term(op1,sons1), Term(op2,sons2) ->
+ if op1 = op2 then
+ List.fold_left2 (fun s t1 t2 -> compsubst (unify (substitute s t1)
+ (substitute s t2)) s)
+ [] sons1 sons2
+ else failwith "unify"
+
+
+(* We need to print terms with variables independently from input terms
+ obtained by parsing. We give arbitrary names v1,v2,... to their variables.
+*)
+
+let infixes = ["+";"*"]
+
+let pretty_term _ = ()
+let pretty_close _ = ()
+
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: equations.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(****************** Equation manipulations *************)
+
+
+
+type rule =
+ { number: int;
+ numvars: int;
+ lhs: term;
+ rhs: term }
+
+(* standardizes an equation so its variables are 1,2,... *)
+
+let mk_rule num m n =
+ let all_vars = union (vars m) (vars n) in
+ let counter = ref 0 in
+ let subst =
+ List.map (fun v -> incr counter; (v, Var !counter)) (List.rev all_vars) in
+ { number = num;
+ numvars = !counter;
+ lhs = substitute subst m;
+ rhs = substitute subst n }
+
+
+(* checks that rules are numbered in sequence and returns their number *)
+
+let check_rules rules =
+ let counter = ref 0 in
+ List.iter (fun r -> incr counter;
+ if r.number <> !counter
+ then failwith "Rule numbers not in sequence")
+ rules;
+ !counter
+
+
+let pretty_rule rule =
+ print_int rule.number; print_string " : ";
+ pretty_term rule.lhs; print_string " = "; pretty_term rule.rhs;
+ print_newline()
+
+
+let pretty_rules rules = List.iter pretty_rule rules
+
+(****************** Rewriting **************************)
+
+(* Top-level rewriting. Let eq:L=R be an equation, M be a term such that L<=M.
+ With sigma = matching L M, we define the image of M by eq as sigma(R) *)
+let reduce l m r =
+ substitute (matching l m) r
+
+(* Test whether m can be reduced by l, i.e. m contains an instance of l. *)
+
+let can_match l m =
+ try let _ = matching l m in true
+ with Failure _ -> false
+
+let rec reducible l m =
+ can_match l m ||
+ (match m with
+ | Term(_,sons) -> List.exists (reducible l) sons
+ | _ -> false)
+
+(* Top-level rewriting with multiple rules. *)
+
+let rec mreduce rules m =
+ match rules with
+ [] -> failwith "mreduce"
+ | rule::rest ->
+ try
+ reduce rule.lhs m rule.rhs
+ with Failure _ ->
+ mreduce rest m
+
+
+(* One step of rewriting in leftmost-outermost strategy,
+ with multiple rules. Fails if no redex is found *)
+
+let rec mrewrite1 rules m =
+ try
+ mreduce rules m
+ with Failure _ ->
+ match m with
+ Var n -> failwith "mrewrite1"
+ | Term(f, sons) -> Term(f, mrewrite1_sons rules sons)
+
+and mrewrite1_sons rules = function
+ [] -> failwith "mrewrite1"
+ | son::rest ->
+ try
+ mrewrite1 rules son :: rest
+ with Failure _ ->
+ son :: mrewrite1_sons rules rest
+
+
+(* Iterating rewrite1. Returns a normal form. May loop forever *)
+
+let rec mrewrite_all rules m =
+ try
+ mrewrite_all rules (mrewrite1 rules m)
+ with Failure _ ->
+ m
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: orderings.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(*********************** Recursive Path Ordering ****************************)
+
+
+type ordering =
+ Greater
+ | Equal
+ | NotGE
+
+let ge_ord order pair = match order pair with NotGE -> false | _ -> true
+and gt_ord order pair = match order pair with Greater -> true | _ -> false
+and eq_ord order pair = match order pair with Equal -> true | _ -> false
+
+
+let rec rem_eq equiv x = function
+ [] -> failwith "rem_eq"
+ | y::l -> if equiv (x,y) then l else y :: rem_eq equiv x l
+
+
+let diff_eq equiv (x,y) =
+ let rec diffrec = function
+ ([],_) as p -> p
+ | (h::t, y) -> try
+ diffrec (t, rem_eq equiv h y)
+ with Failure _ ->
+ let (x',y') = diffrec (t,y) in (h::x',y') in
+ if List.length x > List.length y then diffrec(y,x) else diffrec(x,y)
+
+
+(* Multiset extension of order *)
+
+let mult_ext order = function
+ Term(_,sons1), Term(_,sons2) ->
+ begin match diff_eq (eq_ord order) (sons1,sons2) with
+ ([],[]) -> Equal
+ | (l1,l2) ->
+ if List.for_all
+ (fun n -> List.exists (fun m -> gt_ord order (m,n)) l1) l2
+ then Greater else NotGE
+ end
+ | _ -> failwith "mult_ext"
+
+
+(* Lexicographic extension of order *)
+
+let lex_ext order = function
+ (Term(_,sons1) as m), (Term(_,sons2) as n) ->
+ let rec lexrec = function
+ ([] , []) -> Equal
+ | ([] , _ ) -> NotGE
+ | ( _ , []) -> Greater
+ | (x1::l1, x2::l2) ->
+ match order (x1,x2) with
+ Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
+ then Greater else NotGE
+ | Equal -> lexrec (l1,l2)
+ | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
+ then Greater else NotGE in
+ lexrec (sons1, sons2)
+ | _ -> failwith "lex_ext"
+
+
+(* Recursive path ordering *)
+
+let rpo op_order ext =
+ let rec rporec (m,n) =
+ if m = n then Equal else
+ match m with
+ Var vm -> NotGE
+ | Term(op1,sons1) ->
+ match n with
+ Var vn ->
+ if occurs vn m then Greater else NotGE
+ | Term(op2,sons2) ->
+ match (op_order op1 op2) with
+ Greater ->
+ if List.for_all (fun n' -> gt_ord rporec (m,n')) sons2
+ then Greater else NotGE
+ | Equal ->
+ ext rporec (m,n)
+ | NotGE ->
+ if List.exists (fun m' -> ge_ord rporec (m',n)) sons1
+ then Greater else NotGE
+ in rporec
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: kb.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+
+(****************** Critical pairs *********************)
+
+(* All (u,subst) such that N/u (&var) unifies with M,
+ with principal unifier subst *)
+
+let rec super m = function
+ Term(_,sons) as n ->
+ let rec collate n = function
+ [] -> []
+ | son::rest ->
+ List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+ @ collate (n+1) rest in
+ let insides = collate 1 sons in
+ begin try
+ ([], unify m n) :: insides
+ with Failure _ ->
+ insides
+ end
+ | _ -> []
+
+
+(* Ex :
+let (m,_) = <>
+and (n,_) = <> in super m n
+==> [[1],[2,Term ("B",[])]; x <- B
+ [2],[2,Term ("A",[]); 1,Term ("B",[])]] x <- A y <- B
+*)
+
+(* All (u,subst), u&[], such that n/u unifies with m *)
+
+let super_strict m = function
+ Term(_,sons) ->
+ let rec collate n = function
+ [] -> []
+ | son::rest ->
+ List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+ @ collate (n+1) rest in
+ collate 1 sons
+ | _ -> []
+
+
+(* Critical pairs of l1=r1 with l2=r2 *)
+(* critical_pairs : term_pair -> term_pair -> term_pair list *)
+let critical_pairs (l1,r1) (l2,r2) =
+ let mk_pair (u,subst) =
+ substitute subst (replace l2 u r1), substitute subst r2 in
+ List.map mk_pair (super l1 l2)
+
+(* Strict critical pairs of l1=r1 with l2=r2 *)
+(* strict_critical_pairs : term_pair -> term_pair -> term_pair list *)
+let strict_critical_pairs (l1,r1) (l2,r2) =
+ let mk_pair (u,subst) =
+ substitute subst (replace l2 u r1), substitute subst r2 in
+ List.map mk_pair (super_strict l1 l2)
+
+
+(* All critical pairs of eq1 with eq2 *)
+let mutual_critical_pairs eq1 eq2 =
+ (strict_critical_pairs eq1 eq2) @ (critical_pairs eq2 eq1)
+
+(* Renaming of variables *)
+
+let rename n (t1,t2) =
+ let rec ren_rec = function
+ Var k -> Var(k+n)
+ | Term(op,sons) -> Term(op, List.map ren_rec sons) in
+ (ren_rec t1, ren_rec t2)
+
+
+(************************ Completion ******************************)
+
+let deletion_message rule =
+ print_string "Rule ";print_int rule.number; print_string " deleted";
+ print_newline()
+
+
+(* Generate failure message *)
+let non_orientable (m,n) =
+ pretty_term m; print_string " = "; pretty_term n; print_newline()
+
+
+let rec partition p = function
+ [] -> ([], [])
+ | x::l -> let (l1, l2) = partition p l in
+ if p x then (x::l1, l2) else (l1, x::l2)
+
+
+let rec get_rule n = function
+ [] -> raise Not_found
+ | r::l -> if n = r.number then r else get_rule n l
+
+
+(* Improved Knuth-Bendix completion procedure *)
+
+let kb_completion greater =
+ let rec kbrec j rules =
+ let rec process failures (k,l) eqs =
+(****
+ print_string "***kb_completion "; print_int j; print_newline();
+ pretty_rules rules;
+ List.iter non_orientable failures;
+ print_int k; print_string " "; print_int l; print_newline();
+ List.iter non_orientable eqs;
+***)
+ match eqs with
+ [] ->
+ if k rules (* successful completion *)
+ | _ -> print_string "Non-orientable equations :"; print_newline();
+ List.iter non_orientable failures;
+ failwith "kb_completion"
+ end
+ | (m,n)::eqs ->
+ let m' = mrewrite_all rules m
+ and n' = mrewrite_all rules n
+ and enter_rule(left,right) =
+ let new_rule = mk_rule (j+1) left right in
+ pretty_rule new_rule;
+ let left_reducible rule = reducible left rule.lhs in
+ let (redl,irredl) = partition left_reducible rules in
+ List.iter deletion_message redl;
+ let right_reduce rule =
+ mk_rule rule.number rule.lhs
+ (mrewrite_all (new_rule::rules) rule.rhs) in
+ let irreds = List.map right_reduce irredl in
+ let eqs' = List.map (fun rule -> (rule.lhs, rule.rhs)) redl in
+ kbrec (j+1) (new_rule::irreds) [] (k,l) (eqs @ eqs' @ failures) in
+(***
+ print_string "--- Considering "; non_orientable (m', n');
+***)
+ if m' = n' then process failures (k,l) eqs else
+ if greater(m',n') then enter_rule(m',n') else
+ if greater(n',m') then enter_rule(n',m') else
+ process ((m',n')::failures) (k,l) eqs
+
+ and next_criticals failures (k,l) =
+(****
+ print_string "***next_criticals ";
+ print_int k; print_string " "; print_int l ; print_newline();
+****)
+ try
+ let rl = get_rule l rules in
+ let el = (rl.lhs, rl.rhs) in
+ if k=l then
+ process failures (k,l)
+ (strict_critical_pairs el (rename rl.numvars el))
+ else
+ try
+ let rk = get_rule k rules in
+ let ek = (rk.lhs, rk.rhs) in
+ process failures (k,l)
+ (mutual_critical_pairs el (rename rl.numvars ek))
+ with Not_found -> next_criticals failures (k+1,l)
+ with Not_found -> next_criticals failures (1,l+1)
+ in process
+ in kbrec
+
+
+(* complete_rules is assumed locally confluent, and checked Noetherian with
+ ordering greater, rules is any list of rules *)
+
+let kb_complete greater complete_rules rules =
+ let n = check_rules complete_rules
+ and eqs = List.map (fun rule -> (rule.lhs, rule.rhs)) rules in
+ let completed_rules =
+ kb_completion greater n complete_rules [] (n,n) eqs in
+ print_string "Canonical set found :"; print_newline();
+ pretty_rules (List.rev completed_rules)
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: kbmain.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(****
+let group_rules = [
+ { number = 1; numvars = 1;
+ lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
+ { number = 2; numvars = 1;
+ lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
+ { number = 3; numvars = 3;
+ lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
+ rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
+]
+****)
+
+let geom_rules = [
+ { number = 1; numvars = 1;
+ lhs = Term ("*",[(Term ("U",[])); (Var 1)]);
+ rhs = Var 1 };
+ { number = 2; numvars = 1;
+ lhs = Term ("*",[(Term ("I",[(Var 1)])); (Var 1)]);
+ rhs = Term ("U",[]) };
+ { number = 3; numvars = 3;
+ lhs = Term ("*",[(Term ("*",[(Var 1); (Var 2)])); (Var 3)]);
+ rhs = Term ("*",[(Var 1); (Term ("*",[(Var 2); (Var 3)]))]) };
+ { number = 4; numvars = 0;
+ lhs = Term ("*",[(Term ("A",[])); (Term ("B",[]))]);
+ rhs = Term ("*",[(Term ("B",[])); (Term ("A",[]))]) };
+ { number = 5; numvars = 0;
+ lhs = Term ("*",[(Term ("C",[])); (Term ("C",[]))]);
+ rhs = Term ("U",[]) };
+ { number = 6; numvars = 0;
+ lhs = Term("*",
+ [(Term ("C",[]));
+ (Term ("*",[(Term ("A",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+ rhs = Term ("I",[(Term ("A",[]))]) };
+ { number = 7; numvars = 0;
+ lhs = Term("*",
+ [(Term ("C",[]));
+ (Term ("*",[(Term ("B",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+ rhs = Term ("B",[]) }
+]
+
+let group_rank = function
+ "U" -> 0
+ | "*" -> 1
+ | "I" -> 2
+ | "B" -> 3
+ | "C" -> 4
+ | "A" -> 5
+ | _ -> assert false
+
+let group_precedence op1 op2 =
+ let r1 = group_rank op1
+ and r2 = group_rank op2 in
+ if r1 = r2 then Equal else
+ if r1 > r2 then Greater else NotGE
+
+let group_order = rpo group_precedence lex_ext
+
+let greater pair =
+ match group_order pair with Greater -> true | _ -> false
+
+let _ =
+ for i = 1 to 20 do kb_complete greater [] geom_rules done
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/kb_no_exc.ml js-of-ocaml-2.2/benchmarks/sources/ml/kb_no_exc.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/kb_no_exc.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/kb_no_exc.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,632 @@
+
+let print_string _ = ()
+let print_int _ = ()
+let print_newline _ = ()
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: terms.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(****************** Term manipulations *****************)
+
+type term =
+ Var of int
+ | Term of string * term list
+
+let rec union l1 l2 =
+ match l1 with
+ [] -> l2
+ | a::r -> if List.mem a l2 then union r l2 else a :: union r l2
+
+
+let rec vars = function
+ Var n -> [n]
+ | Term(_,l) -> vars_of_list l
+and vars_of_list = function
+ [] -> []
+ | t::r -> union (vars t) (vars_of_list r)
+
+
+let rec substitute subst = function
+ Term(oper,sons) -> Term(oper, List.map (substitute subst) sons)
+ | Var(n) as t -> try List.assoc n subst with Not_found -> t
+
+
+(* Term replacement: replace M u N is M[u<-N]. *)
+
+let rec replace m u n =
+ match (u, m) with
+ [], _ -> n
+ | i::u, Term(oper, sons) -> Term(oper, replace_nth i sons u n)
+ | _ -> failwith "replace"
+
+and replace_nth i sons u n =
+ match sons with
+ s::r -> if i = 1
+ then replace s u n :: r
+ else s :: replace_nth (i-1) r u n
+ | [] -> failwith "replace_nth"
+
+
+(* Term matching. *)
+
+let rec fold_left2_opt f accu l1 l2 =
+ match (l1, l2) with
+ ([], []) -> Some accu
+ | (a1::l1, a2::l2) ->
+ begin match f accu a1 a2 with
+ None -> None
+ | Some accu' -> fold_left2_opt f accu' l1 l2
+ end
+ | (_, _) -> invalid_arg "List.fold_left2"
+
+
+let rec match_rec subst t1 t2 =
+ match (t1, t2) with
+ Var v, _ ->
+ if List.mem_assoc v subst then
+ if t2 = List.assoc v subst then Some subst else None
+ else
+ Some ((v, t2) :: subst)
+ | Term(op1,sons1), Term(op2,sons2) ->
+ if op1 = op2
+ then fold_left2_opt match_rec subst sons1 sons2
+ else None
+ | _ -> None
+
+let matching term1 term2 = match_rec [] term1 term2
+
+
+(* A naive unification algorithm. *)
+
+let compsubst subst1 subst2 =
+ (List.map (fun (v,t) -> (v, substitute subst1 t)) subst2) @ subst1
+
+
+let rec occurs n = function
+ Var m -> m = n
+ | Term(_,sons) -> List.exists (occurs n) sons
+
+
+let rec unify term1 term2 =
+ match (term1, term2) with
+ Var n1, _ ->
+ if term1 = term2 then []
+ else if occurs n1 term2 then failwith "unify"
+ else [n1, term2]
+ | term1, Var n2 ->
+ if occurs n2 term1 then failwith "unify"
+ else [n2, term1]
+ | Term(op1,sons1), Term(op2,sons2) ->
+ if op1 = op2 then
+ List.fold_left2 (fun s t1 t2 -> compsubst (unify (substitute s t1)
+ (substitute s t2)) s)
+ [] sons1 sons2
+ else failwith "unify"
+
+
+(* We need to print terms with variables independently from input terms
+ obtained by parsing. We give arbitrary names v1,v2,... to their variables.
+*)
+
+let infixes = ["+";"*"]
+
+let rec pretty_term = function
+ Var n ->
+ print_string "v"; print_int n
+ | Term (oper,sons) ->
+ if List.mem oper infixes then begin
+ match sons with
+ [s1;s2] ->
+ pretty_close s1; print_string oper; pretty_close s2
+ | _ ->
+ failwith "pretty_term : infix arity <> 2"
+ end else begin
+ print_string oper;
+ match sons with
+ [] -> ()
+ | t::lt -> print_string "(";
+ pretty_term t;
+ List.iter (fun t -> print_string ","; pretty_term t) lt;
+ print_string ")"
+ end
+
+and pretty_close = function
+ Term(oper, _) as m ->
+ if List.mem oper infixes then begin
+ print_string "("; pretty_term m; print_string ")"
+ end else
+ pretty_term m
+ | m ->
+ pretty_term m
+
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: equations.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(****************** Equation manipulations *************)
+
+
+
+type rule =
+ { number: int;
+ numvars: int;
+ lhs: term;
+ rhs: term }
+
+(* standardizes an equation so its variables are 1,2,... *)
+
+let mk_rule num m n =
+ let all_vars = union (vars m) (vars n) in
+ let counter = ref 0 in
+ let subst =
+ List.map (fun v -> incr counter; (v, Var !counter)) (List.rev all_vars) in
+ { number = num;
+ numvars = !counter;
+ lhs = substitute subst m;
+ rhs = substitute subst n }
+
+
+(* checks that rules are numbered in sequence and returns their number *)
+
+let check_rules rules =
+ let counter = ref 0 in
+ List.iter (fun r -> incr counter;
+ if r.number <> !counter
+ then failwith "Rule numbers not in sequence")
+ rules;
+ !counter
+
+
+let pretty_rule rule =
+ print_int rule.number; print_string " : ";
+ pretty_term rule.lhs; print_string " = "; pretty_term rule.rhs;
+ print_newline()
+
+
+let pretty_rules rules = List.iter pretty_rule rules
+
+(****************** Rewriting **************************)
+
+(* Top-level rewriting. Let eq:L=R be an equation, M be a term such that L<=M.
+ With sigma = matching L M, we define the image of M by eq as sigma(R) *)
+let reduce l m r =
+ match matching l m with
+ Some s -> Some (substitute s r)
+ | None -> None
+
+(* Test whether m can be reduced by l, i.e. m contains an instance of l. *)
+
+let can_match l m =
+ match matching l m with Some _ -> true | None -> false
+
+let rec reducible l m =
+ can_match l m ||
+ (match m with
+ | Term(_,sons) -> List.exists (reducible l) sons
+ | _ -> false)
+
+(* Top-level rewriting with multiple rules. *)
+
+let rec mreduce rules m =
+ match rules with
+ [] -> None
+ | rule::rest ->
+ match
+ reduce rule.lhs m rule.rhs
+ with
+ Some _ as v -> v
+ | None ->
+ mreduce rest m
+
+(* One step of rewriting in leftmost-outermost strategy,
+ with multiple rules. Fails if no redex is found *)
+
+let rec mrewrite1 rules m =
+ match
+ mreduce rules m
+ with Some v -> v
+ | None ->
+ match m with
+ Var n -> failwith "mrewrite1"
+ | Term(f, sons) -> Term(f, mrewrite1_sons rules sons)
+
+and mrewrite1_sons rules = function
+ [] -> failwith "mrewrite1"
+ | son::rest ->
+ try
+ mrewrite1 rules son :: rest
+ with Failure _ ->
+ son :: mrewrite1_sons rules rest
+
+
+(* Iterating rewrite1. Returns a normal form. May loop forever *)
+
+let rec mrewrite_all rules m =
+ try
+ mrewrite_all rules (mrewrite1 rules m)
+ with Failure _ ->
+ m
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: orderings.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(*********************** Recursive Path Ordering ****************************)
+
+
+type ordering =
+ Greater
+ | Equal
+ | NotGE
+
+let ge_ord order pair = match order pair with NotGE -> false | _ -> true
+and gt_ord order pair = match order pair with Greater -> true | _ -> false
+and eq_ord order pair = match order pair with Equal -> true | _ -> false
+
+
+let rec rem_eq equiv x = function
+ [] -> failwith "rem_eq"
+ | y::l -> if equiv (x,y) then l else y :: rem_eq equiv x l
+
+
+let diff_eq equiv (x,y) =
+ let rec diffrec = function
+ ([],_) as p -> p
+ | (h::t, y) -> try
+ diffrec (t, rem_eq equiv h y)
+ with Failure _ ->
+ let (x',y') = diffrec (t,y) in (h::x',y') in
+ if List.length x > List.length y then diffrec(y,x) else diffrec(x,y)
+
+
+(* Multiset extension of order *)
+
+let mult_ext order = function
+ Term(_,sons1), Term(_,sons2) ->
+ begin match diff_eq (eq_ord order) (sons1,sons2) with
+ ([],[]) -> Equal
+ | (l1,l2) ->
+ if List.for_all
+ (fun n -> List.exists (fun m -> gt_ord order (m,n)) l1) l2
+ then Greater else NotGE
+ end
+ | _ -> failwith "mult_ext"
+
+
+(* Lexicographic extension of order *)
+
+let lex_ext order = function
+ (Term(_,sons1) as m), (Term(_,sons2) as n) ->
+ let rec lexrec = function
+ ([] , []) -> Equal
+ | ([] , _ ) -> NotGE
+ | ( _ , []) -> Greater
+ | (x1::l1, x2::l2) ->
+ match order (x1,x2) with
+ Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
+ then Greater else NotGE
+ | Equal -> lexrec (l1,l2)
+ | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
+ then Greater else NotGE in
+ lexrec (sons1, sons2)
+ | _ -> failwith "lex_ext"
+
+
+(* Recursive path ordering *)
+
+let rpo op_order ext =
+ let rec rporec (m,n) =
+ if m = n then Equal else
+ match m with
+ Var vm -> NotGE
+ | Term(op1,sons1) ->
+ match n with
+ Var vn ->
+ if occurs vn m then Greater else NotGE
+ | Term(op2,sons2) ->
+ match (op_order op1 op2) with
+ Greater ->
+ if List.for_all (fun n' -> gt_ord rporec (m,n')) sons2
+ then Greater else NotGE
+ | Equal ->
+ ext rporec (m,n)
+ | NotGE ->
+ if List.exists (fun m' -> ge_ord rporec (m',n)) sons1
+ then Greater else NotGE
+ in rporec
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: kb.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+
+(****************** Critical pairs *********************)
+
+(* All (u,subst) such that N/u (&var) unifies with M,
+ with principal unifier subst *)
+
+let rec super m = function
+ Term(_,sons) as n ->
+ let rec collate n = function
+ [] -> []
+ | son::rest ->
+ List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+ @ collate (n+1) rest in
+ let insides = collate 1 sons in
+ begin try
+ ([], unify m n) :: insides
+ with Failure _ ->
+ insides
+ end
+ | _ -> []
+
+
+(* Ex :
+let (m,_) = <>
+and (n,_) = <> in super m n
+==> [[1],[2,Term ("B",[])]; x <- B
+ [2],[2,Term ("A",[]); 1,Term ("B",[])]] x <- A y <- B
+*)
+
+(* All (u,subst), u&[], such that n/u unifies with m *)
+
+let super_strict m = function
+ Term(_,sons) ->
+ let rec collate n = function
+ [] -> []
+ | son::rest ->
+ List.map (fun (u, subst) -> (n::u, subst)) (super m son)
+ @ collate (n+1) rest in
+ collate 1 sons
+ | _ -> []
+
+
+(* Critical pairs of l1=r1 with l2=r2 *)
+(* critical_pairs : term_pair -> term_pair -> term_pair list *)
+let critical_pairs (l1,r1) (l2,r2) =
+ let mk_pair (u,subst) =
+ substitute subst (replace l2 u r1), substitute subst r2 in
+ List.map mk_pair (super l1 l2)
+
+(* Strict critical pairs of l1=r1 with l2=r2 *)
+(* strict_critical_pairs : term_pair -> term_pair -> term_pair list *)
+let strict_critical_pairs (l1,r1) (l2,r2) =
+ let mk_pair (u,subst) =
+ substitute subst (replace l2 u r1), substitute subst r2 in
+ List.map mk_pair (super_strict l1 l2)
+
+
+(* All critical pairs of eq1 with eq2 *)
+let mutual_critical_pairs eq1 eq2 =
+ (strict_critical_pairs eq1 eq2) @ (critical_pairs eq2 eq1)
+
+(* Renaming of variables *)
+
+let rename n (t1,t2) =
+ let rec ren_rec = function
+ Var k -> Var(k+n)
+ | Term(op,sons) -> Term(op, List.map ren_rec sons) in
+ (ren_rec t1, ren_rec t2)
+
+
+(************************ Completion ******************************)
+
+let deletion_message rule =
+ print_string "Rule ";print_int rule.number; print_string " deleted";
+ print_newline()
+
+
+(* Generate failure message *)
+let non_orientable (m,n) =
+ pretty_term m; print_string " = "; pretty_term n; print_newline()
+
+
+let rec partition p = function
+ [] -> ([], [])
+ | x::l -> let (l1, l2) = partition p l in
+ if p x then (x::l1, l2) else (l1, x::l2)
+
+
+let rec get_rule n = function
+ [] -> raise Not_found
+ | r::l -> if n = r.number then r else get_rule n l
+
+
+(* Improved Knuth-Bendix completion procedure *)
+
+let kb_completion greater =
+ let rec kbrec j rules =
+ let rec process failures (k,l) eqs =
+(****
+ print_string "***kb_completion "; print_int j; print_newline();
+ pretty_rules rules;
+ List.iter non_orientable failures;
+ print_int k; print_string " "; print_int l; print_newline();
+ List.iter non_orientable eqs;
+***)
+ match eqs with
+ [] ->
+ if k rules (* successful completion *)
+ | _ -> print_string "Non-orientable equations :"; print_newline();
+ List.iter non_orientable failures;
+ failwith "kb_completion"
+ end
+ | (m,n)::eqs ->
+ let m' = mrewrite_all rules m
+ and n' = mrewrite_all rules n
+ and enter_rule(left,right) =
+ let new_rule = mk_rule (j+1) left right in
+ pretty_rule new_rule;
+ let left_reducible rule = reducible left rule.lhs in
+ let (redl,irredl) = partition left_reducible rules in
+ List.iter deletion_message redl;
+ let right_reduce rule =
+ mk_rule rule.number rule.lhs
+ (mrewrite_all (new_rule::rules) rule.rhs) in
+ let irreds = List.map right_reduce irredl in
+ let eqs' = List.map (fun rule -> (rule.lhs, rule.rhs)) redl in
+ kbrec (j+1) (new_rule::irreds) [] (k,l) (eqs @ eqs' @ failures) in
+(***
+ print_string "--- Considering "; non_orientable (m', n');
+***)
+ if m' = n' then process failures (k,l) eqs else
+ if greater(m',n') then enter_rule(m',n') else
+ if greater(n',m') then enter_rule(n',m') else
+ process ((m',n')::failures) (k,l) eqs
+
+ and next_criticals failures (k,l) =
+(****
+ print_string "***next_criticals ";
+ print_int k; print_string " "; print_int l ; print_newline();
+****)
+ try
+ let rl = get_rule l rules in
+ let el = (rl.lhs, rl.rhs) in
+ if k=l then
+ process failures (k,l)
+ (strict_critical_pairs el (rename rl.numvars el))
+ else
+ try
+ let rk = get_rule k rules in
+ let ek = (rk.lhs, rk.rhs) in
+ process failures (k,l)
+ (mutual_critical_pairs el (rename rl.numvars ek))
+ with Not_found -> next_criticals failures (k+1,l)
+ with Not_found -> next_criticals failures (1,l+1)
+ in process
+ in kbrec
+
+
+(* complete_rules is assumed locally confluent, and checked Noetherian with
+ ordering greater, rules is any list of rules *)
+
+let kb_complete greater complete_rules rules =
+ let n = check_rules complete_rules
+ and eqs = List.map (fun rule -> (rule.lhs, rule.rhs)) rules in
+ let completed_rules =
+ kb_completion greater n complete_rules [] (n,n) eqs in
+ print_string "Canonical set found :"; print_newline();
+ pretty_rules (List.rev completed_rules)
+
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: kbmain.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(****
+let group_rules = [
+ { number = 1; numvars = 1;
+ lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
+ { number = 2; numvars = 1;
+ lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
+ { number = 3; numvars = 3;
+ lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
+ rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
+]
+****)
+
+let geom_rules = [
+ { number = 1; numvars = 1;
+ lhs = Term ("*",[(Term ("U",[])); (Var 1)]);
+ rhs = Var 1 };
+ { number = 2; numvars = 1;
+ lhs = Term ("*",[(Term ("I",[(Var 1)])); (Var 1)]);
+ rhs = Term ("U",[]) };
+ { number = 3; numvars = 3;
+ lhs = Term ("*",[(Term ("*",[(Var 1); (Var 2)])); (Var 3)]);
+ rhs = Term ("*",[(Var 1); (Term ("*",[(Var 2); (Var 3)]))]) };
+ { number = 4; numvars = 0;
+ lhs = Term ("*",[(Term ("A",[])); (Term ("B",[]))]);
+ rhs = Term ("*",[(Term ("B",[])); (Term ("A",[]))]) };
+ { number = 5; numvars = 0;
+ lhs = Term ("*",[(Term ("C",[])); (Term ("C",[]))]);
+ rhs = Term ("U",[]) };
+ { number = 6; numvars = 0;
+ lhs = Term("*",
+ [(Term ("C",[]));
+ (Term ("*",[(Term ("A",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+ rhs = Term ("I",[(Term ("A",[]))]) };
+ { number = 7; numvars = 0;
+ lhs = Term("*",
+ [(Term ("C",[]));
+ (Term ("*",[(Term ("B",[])); (Term ("I",[(Term ("C",[]))]))]))]);
+ rhs = Term ("B",[]) }
+]
+
+let group_rank = function
+ "U" -> 0
+ | "*" -> 1
+ | "I" -> 2
+ | "B" -> 3
+ | "C" -> 4
+ | "A" -> 5
+ | _ -> assert false
+
+let group_precedence op1 op2 =
+ let r1 = group_rank op1
+ and r2 = group_rank op2 in
+ if r1 = r2 then Equal else
+ if r1 > r2 then Greater else NotGE
+
+let group_order = rpo group_precedence lex_ext
+
+let greater pair =
+ match group_order pair with Greater -> true | _ -> false
+
+let _ =
+ for i = 1 to 20 do kb_complete greater [] geom_rules done
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/loop.ml js-of-ocaml-2.2/benchmarks/sources/ml/loop.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/loop.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/loop.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1 @@
+for i = 1 to 1000000000 do () done
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/nucleic.ml js-of-ocaml-2.2/benchmarks/sources/ml/nucleic.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/nucleic.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/nucleic.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,3241 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: nucleic.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(* Use floating-point arithmetic *)
+
+external (+) : float -> float -> float = "%addfloat"
+external (-) : float -> float -> float = "%subfloat"
+external ( * ) : float -> float -> float = "%mulfloat"
+external (/) : float -> float -> float = "%divfloat"
+
+(* -- MATH UTILITIES --------------------------------------------------------*)
+
+let constant_pi = 3.14159265358979323846
+let constant_minus_pi = -3.14159265358979323846
+let constant_pi2 = 1.57079632679489661923
+let constant_minus_pi2 = -1.57079632679489661923
+
+(* -- POINTS ----------------------------------------------------------------*)
+
+type pt = { x : float; y : float; z : float }
+
+let
+pt_sub p1 p2
+ = { x = p1.x - p2.x; y = p1.y - p2.y; z = p1.z - p2.z }
+
+let
+pt_dist p1 p2
+ = let dx = p1.x - p2.x
+ and dy = p1.y - p2.y
+ and dz = p1.z - p2.z
+ in
+ sqrt ((dx * dx) + (dy * dy) + (dz * dz))
+
+let
+pt_phi p
+ = let b = atan2 p.x p.z
+ in
+ atan2 ((cos b) * p.z + (sin b) * p.x) p.y
+
+let
+pt_theta p
+ = atan2 p.x p.z
+
+(* -- COORDINATE TRANSFORMATIONS --------------------------------------------*)
+
+(*
+ The notation for the transformations follows "Paul, R.P. (1981) Robot
+ Manipulators. MIT Press." with the exception that our transformation
+ matrices don't have the perspective terms and are the transpose of
+ Paul's one. See also "M\"antyl\"a, M. (1985) An Introduction to
+ Solid Modeling, Computer Science Press" Appendix A.
+
+ The components of a transformation matrix are named like this:
+
+ a b c
+ d e f
+ g h i
+ tx ty tz
+
+ The components tx, ty, and tz are the translation vector.
+*)
+
+type tfo =
+ {a: float; b: float; c: float;
+ d: float; e: float; f: float;
+ g: float; h: float; i: float;
+ tx: float; ty: float; tz: float}
+
+let tfo_id =
+ {a=1.0; b=0.0; c=0.0;
+ d=0.0; e=1.0; f=0.0;
+ g=0.0; h=0.0; i=1.0;
+ tx=0.0; ty=0.0; tz=0.0}
+
+(*
+ The function "tfo-apply" multiplies a transformation matrix, tfo, by a
+ point vector, p. The result is a new point.
+*)
+
+let
+tfo_apply t p
+ = { x = ((p.x * t.a) + (p.y * t.d) + (p.z * t.g) + t.tx);
+ y = ((p.x * t.b) + (p.y * t.e) + (p.z * t.h) + t.ty);
+ z = ((p.x * t.c) + (p.y * t.f) + (p.z * t.i) + t.tz) }
+
+(*
+ The function "tfo-combine" multiplies two transformation matrices A and B.
+ The result is a new matrix which cumulates the transformations described
+ by A and B.
+*)
+
+let
+tfo_combine a b =
+(* *)
+ (* Hand elimination of common subexpressions.
+ Assumes lots of float registers (32 is perfect, 16 still OK).
+ Loses on the I386, of course. *)
+ let a_a = a.a and a_b = a.b and a_c = a.c and a_d = a.d
+ and a_e = a.e and a_f = a.f and a_g = a.g and a_h = a.h
+ and a_i = a.i and a_tx = a.tx and a_ty = a.ty and a_tz = a.tz
+ and b_a = b.a and b_b = b.b and b_c = b.c and b_d = b.d
+ and b_e = b.e and b_f = b.f and b_g = b.g and b_h = b.h
+ and b_i = b.i and b_tx = b.tx and b_ty = b.ty and b_tz = b.tz in
+ { a = ((a_a * b_a) + (a_b * b_d) + (a_c * b_g));
+ b = ((a_a * b_b) + (a_b * b_e) + (a_c * b_h));
+ c = ((a_a * b_c) + (a_b * b_f) + (a_c * b_i));
+ d = ((a_d * b_a) + (a_e * b_d) + (a_f * b_g));
+ e = ((a_d * b_b) + (a_e * b_e) + (a_f * b_h));
+ f = ((a_d * b_c) + (a_e * b_f) + (a_f * b_i));
+ g = ((a_g * b_a) + (a_h * b_d) + (a_i * b_g));
+ h = ((a_g * b_b) + (a_h * b_e) + (a_i * b_h));
+ i = ((a_g * b_c) + (a_h * b_f) + (a_i * b_i));
+ tx = ((a_tx * b_a) + (a_ty * b_d) + (a_tz * b_g) + b_tx);
+ ty = ((a_tx * b_b) + (a_ty * b_e) + (a_tz * b_h) + b_ty);
+ tz = ((a_tx * b_c) + (a_ty * b_f) + (a_tz * b_i) + b_tz)
+ }
+(* *)
+ (* Original without CSE *)
+(* *) (***
+ { a = ((a.a * b.a) + (a.b * b.d) + (a.c * b.g));
+ b = ((a.a * b.b) + (a.b * b.e) + (a.c * b.h));
+ c = ((a.a * b.c) + (a.b * b.f) + (a.c * b.i));
+ d = ((a.d * b.a) + (a.e * b.d) + (a.f * b.g));
+ e = ((a.d * b.b) + (a.e * b.e) + (a.f * b.h));
+ f = ((a.d * b.c) + (a.e * b.f) + (a.f * b.i));
+ g = ((a.g * b.a) + (a.h * b.d) + (a.i * b.g));
+ h = ((a.g * b.b) + (a.h * b.e) + (a.i * b.h));
+ i = ((a.g * b.c) + (a.h * b.f) + (a.i * b.i));
+ tx = ((a.tx * b.a) + (a.ty * b.d) + (a.tz * b.g) + b.tx);
+ ty = ((a.tx * b.b) + (a.ty * b.e) + (a.tz * b.h) + b.ty);
+ tz = ((a.tx * b.c) + (a.ty * b.f) + (a.tz * b.i) + b.tz)
+ }
+ ***) (* *)
+
+(*
+ The function "tfo-inv-ortho" computes the inverse of a homogeneous
+ transformation matrix.
+*)
+
+let
+tfo_inv_ortho t =
+ { a = t.a; b = t.d; c = t.g;
+ d = t.b; e = t.e; f = t.h;
+ g = t.c; h = t.f; i = t.i;
+ tx = (-.((t.a * t.tx) + (t.b * t.ty) + (t.c * t.tz)));
+ ty = (-.((t.d * t.tx) + (t.e * t.ty) + (t.f * t.tz)));
+ tz = (-.((t.g * t.tx) + (t.h * t.ty) + (t.i * t.tz)))
+ }
+
+(*
+ Given three points p1, p2, and p3, the function "tfo-align" computes
+ a transformation matrix such that point p1 gets mapped to (0,0,0), p2 gets
+ mapped to the Y axis and p3 gets mapped to the YZ plane.
+*)
+
+let
+tfo_align p1 p2 p3
+ = let x31 = p3.x - p1.x in
+ let y31 = p3.y - p1.y in
+ let z31 = p3.z - p1.z in
+ let rotpy = pt_sub p2 p1 in
+ let phi = pt_phi rotpy in
+ let theta = pt_theta rotpy in
+ let sinp = sin phi in
+ let sint = sin theta in
+ let cosp = cos phi in
+ let cost = cos theta in
+ let sinpsint = sinp * sint in
+ let sinpcost = sinp * cost in
+ let cospsint = cosp * sint in
+ let cospcost = cosp * cost in
+ let rotpz =
+ { x = ((cost * x31) - (sint * z31));
+ y = ((sinpsint * x31) + (cosp * y31) + (sinpcost * z31));
+ z = ((cospsint * x31) + (-.(sinp * y31)) + (cospcost * z31)) } in
+ let rho = pt_theta rotpz in
+ let cosr = cos rho in
+ let sinr = sin rho in
+ let x = (-.(p1.x * cost)) + (p1.z * sint) in
+ let y = ((-.(p1.x * sinpsint)) - (p1.y * cosp)) - (p1.z * sinpcost) in
+ let z = ((-.(p1.x * cospsint) + (p1.y * sinp))) - (p1.z * cospcost) in
+ { a = ((cost * cosr) - (cospsint * sinr));
+ b = sinpsint;
+ c = ((cost * sinr) + (cospsint * cosr));
+ d = (sinp * sinr);
+ e = cosp;
+ f = (-.(sinp * cosr));
+ g = ((-.(sint * cosr)) - (cospcost * sinr));
+ h = sinpcost;
+ i = ((-.(sint * sinr) + (cospcost * cosr)));
+ tx = ((x * cosr) - (z * sinr));
+ ty = y;
+ tz = ((x * sinr + (z * cosr)))
+ }
+
+(* -- NUCLEIC ACID CONFORMATIONS DATA BASE ----------------------------------*)
+
+(*
+ Numbering of atoms follows the paper:
+
+ IUPAC-IUB Joint Commission on Biochemical Nomenclature (JCBN)
+ (1983) Abbreviations and Symbols for the Description of
+ Conformations of Polynucleotide Chains. Eur. J. Biochem 131,
+ 9-15.
+*)
+
+(* Define remaining atoms for each nucleotide type. *)
+
+type nuc_specific =
+ A of pt*pt*pt*pt*pt*pt*pt*pt
+| C of pt*pt*pt*pt*pt*pt
+| G of pt*pt*pt*pt*pt*pt*pt*pt*pt
+| U of pt*pt*pt*pt*pt
+
+(*
+ A n6 n7 n9 c8 h2 h61 h62 h8
+ C n4 o2 h41 h42 h5 h6
+ G n2 n7 n9 c8 o6 h1 h21 h22 h8
+ U o2 o4 h3 h5 h6
+*)
+
+(* Define part common to all 4 nucleotide types. *)
+
+type nuc =
+ N of tfo*tfo*tfo*tfo*
+ pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*
+ pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*pt*
+ pt*nuc_specific
+
+(*
+ dgf_base_tfo ; defines the standard position for wc and wc_dumas
+ p_o3'_275_tfo ; defines the standard position for the connect function
+ p_o3'_180_tfo
+ p_o3'_60_tfo
+ p o1p o2p o5' c5' h5' h5'' c4' h4' o4' c1' h1' c2' h2'' o2' h2' c3'
+ h3' o3' n1 n3 c2 c4 c5 c6
+*)
+
+let is_A = function
+ N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,A(_,_,_,_,_,_,_,_)) -> true
+ | _ -> false
+
+let is_C = function
+ N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,C(_,_,_,_,_,_)) -> true
+ | _ -> false
+
+let is_G = function
+ N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,G(_,_,_,_,_,_,_,_,_)) -> true
+ | _ -> false
+
+let
+nuc_C1'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = c1'
+
+let
+nuc_C2
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = c2
+
+let
+nuc_C3'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = c3'
+
+let
+nuc_C4
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = c4
+
+let
+nuc_C4'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = c4'
+
+let
+nuc_N1
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = n1
+
+let
+nuc_O3'
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = o3'
+
+let
+nuc_P
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = p
+
+let
+nuc_dgf_base_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = dgf_base_tfo
+
+let
+nuc_p_o3'_180_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = p_o3'_180_tfo
+
+let
+nuc_p_o3'_275_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = p_o3'_275_tfo
+
+let
+nuc_p_o3'_60_tfo
+(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
+ = p_o3'_60_tfo
+
+let
+rA_N9 = function
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,A (n6,n7,n9,c8,h2,h61,h62,h8))) -> n9
+| _ -> assert false
+
+
+let
+rG_N9 = function
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,G (n2,n7,n9,c8,o6,h1,h21,h22,h8))) -> n9
+| _ -> assert false
+
+(* Database of nucleotide conformations: *)
+
+let rA
+ = N(
+ { a= -0.0018; b= -0.8207; c=0.5714; (* dgf_base_tfo *)
+ d=0.2679; e= -0.5509; f= -0.7904;
+ g=0.9634; h=0.1517; i=0.2209;
+ tx=0.0073; ty=8.4030; tz=0.6232 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4550; y = 8.2120; z = -2.8810 }, (* C5' *)
+ { x = 5.4546; y = 8.8508; z = -1.9978 }, (* H5' *)
+ { x = 5.7588; y = 8.6625; z = -3.8259 }, (* H5'' *)
+ { x = 6.4970; y = 7.1480; z = -2.5980 }, (* C4' *)
+ { x = 7.4896; y = 7.5919; z = -2.5214 }, (* H4' *)
+ { x = 6.1630; y = 6.4860; z = -1.3440 }, (* O4' *)
+ { x = 6.5400; y = 5.1200; z = -1.4190 }, (* C1' *)
+ { x = 7.2763; y = 4.9681; z = -0.6297 }, (* H1' *)
+ { x = 7.1940; y = 4.8830; z = -2.7770 }, (* C2' *)
+ { x = 6.8667; y = 3.9183; z = -3.1647 }, (* H2'' *)
+ { x = 8.5860; y = 5.0910; z = -2.6140 }, (* O2' *)
+ { x = 8.9510; y = 4.7626; z = -1.7890 }, (* H2' *)
+ { x = 6.5720; y = 6.0040; z = -3.6090 }, (* C3' *)
+ { x = 5.5636; y = 5.7066; z = -3.8966 }, (* H3' *)
+ { x = 7.3801; y = 6.3562; z = -4.7350 }, (* O3' *)
+ { x = 4.7150; y = 0.4910; z = -0.1360 }, (* N1 *)
+ { x = 6.3490; y = 2.1730; z = -0.6020 }, (* N3 *)
+ { x = 5.9530; y = 0.9650; z = -0.2670 }, (* C2 *)
+ { x = 5.2900; y = 2.9790; z = -0.8260 }, (* C4 *)
+ { x = 3.9720; y = 2.6390; z = -0.7330 }, (* C5 *)
+ { x = 3.6770; y = 1.3160; z = -0.3660 }, (* C6 *)
+ (A (
+ { x = 2.4280; y = 0.8450; z = -0.2360 }, (* N6 *)
+ { x = 3.1660; y = 3.7290; z = -1.0360 }, (* N7 *)
+ { x = 5.3170; y = 4.2990; z = -1.1930 }, (* N9 *)
+ { x = 4.0100; y = 4.6780; z = -1.2990 }, (* C8 *)
+ { x = 6.6890; y = 0.1903; z = -0.0518 }, (* H2 *)
+ { x = 1.6470; y = 1.4460; z = -0.4040 }, (* H61 *)
+ { x = 2.2780; y = -0.1080; z = -0.0280 }, (* H62 *)
+ { x = 3.4421; y = 5.5744; z = -1.5482 }) (* H8 *)
+ )
+ )
+
+let rA01
+ = N(
+ { a= -0.0043; b= -0.8175; c=0.5759; (* dgf_base_tfo *)
+ d=0.2617; e= -0.5567; f= -0.7884;
+ g=0.9651; h=0.1473; i=0.2164;
+ tx=0.0359; ty=8.3929; tz=0.5532 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5' *)
+ { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5' *)
+ { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+ { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4' *)
+ { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4' *)
+ { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4' *)
+ { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1' *)
+ { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1' *)
+ { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2' *)
+ { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+ { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2' *)
+ { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2' *)
+ { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3' *)
+ { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3' *)
+ { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3' *)
+ { x = 4.7442; y = 0.4514; z = -0.1390 }, (* N1 *)
+ { x = 6.3687; y = 2.1459; z = -0.5926 }, (* N3 *)
+ { x = 5.9795; y = 0.9335; z = -0.2657 }, (* C2 *)
+ { x = 5.3052; y = 2.9471; z = -0.8125 }, (* C4 *)
+ { x = 3.9891; y = 2.5987; z = -0.7230 }, (* C5 *)
+ { x = 3.7016; y = 1.2717; z = -0.3647 }, (* C6 *)
+ (A (
+ { x = 2.4553; y = 0.7925; z = -0.2390 }, (* N6 *)
+ { x = 3.1770; y = 3.6859; z = -1.0198 }, (* N7 *)
+ { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9 *)
+ { x = 4.0156; y = 4.6415; z = -1.2759 }, (* C8 *)
+ { x = 6.7198; y = 0.1618; z = -0.0547 }, (* H2 *)
+ { x = 1.6709; y = 1.3900; z = -0.4039 }, (* H61 *)
+ { x = 2.3107; y = -0.1627; z = -0.0373 }, (* H62 *)
+ { x = 3.4426; y = 5.5361; z = -1.5199 }) (* H8 *)
+ )
+ )
+
+let rA02
+ = N(
+ { a=0.5566; b=0.0449; c=0.8296; (* dgf_base_tfo *)
+ d=0.5125; e=0.7673; f= -0.3854;
+ g= -0.6538; h=0.6397; i=0.4041;
+ tx= -9.1161; ty= -3.7679; tz= -2.9968 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5' *)
+ { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5' *)
+ { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+ { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4' *)
+ { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4' *)
+ { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4' *)
+ { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1' *)
+ { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1' *)
+ { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2' *)
+ { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+ { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2' *)
+ { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2' *)
+ { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3' *)
+ { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3' *)
+ { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3' *)
+ { x = 10.3245; y = 8.5459; z = 1.5467 }, (* N1 *)
+ { x = 9.8051; y = 6.9432; z = -0.1497 }, (* N3 *)
+ { x = 10.5175; y = 7.4328; z = 0.8408 }, (* C2 *)
+ { x = 8.7523; y = 7.7422; z = -0.4228 }, (* C4 *)
+ { x = 8.4257; y = 8.9060; z = 0.2099 }, (* C5 *)
+ { x = 9.2665; y = 9.3242; z = 1.2540 }, (* C6 *)
+ (A (
+ { x = 9.0664; y = 10.4462; z = 1.9610 }, (* N6 *)
+ { x = 7.2750; y = 9.4537; z = -0.3428 }, (* N7 *)
+ { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9 *)
+ { x = 6.9479; y = 8.6157; z = -1.2771 }, (* C8 *)
+ { x = 11.4063; y = 6.9047; z = 1.1859 }, (* H2 *)
+ { x = 8.2845; y = 11.0341; z = 1.7552 }, (* H61 *)
+ { x = 9.6584; y = 10.6647; z = 2.7198 }, (* H62 *)
+ { x = 6.0430; y = 8.9853; z = -1.7594 }) (* H8 *)
+ )
+ )
+let rA03
+ = N(
+ { a= -0.5021; b=0.0731; c=0.8617; (* dgf_base_tfo *)
+ d= -0.8112; e=0.3054; f= -0.4986;
+ g= -0.2996; h= -0.9494; i= -0.0940;
+ tx=6.4273; ty= -5.1944; tz= -3.7807 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5' *)
+ { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5' *)
+ { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+ { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4' *)
+ { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4' *)
+ { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4' *)
+ { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1' *)
+ { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1' *)
+ { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2' *)
+ { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+ { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2' *)
+ { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2' *)
+ { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3' *)
+ { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3' *)
+ { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3' *)
+ { x = 9.6740; y = 4.7656; z = -7.6614 }, (* N1 *)
+ { x = 9.0739; y = 4.3013; z = -5.3941 }, (* N3 *)
+ { x = 9.8416; y = 4.2192; z = -6.4581 }, (* C2 *)
+ { x = 7.9885; y = 5.0632; z = -5.6446 }, (* C4 *)
+ { x = 7.6822; y = 5.6856; z = -6.8194 }, (* C5 *)
+ { x = 8.5831; y = 5.5215; z = -7.8840 }, (* C6 *)
+ (A (
+ { x = 8.4084; y = 6.0747; z = -9.0933 }, (* N6 *)
+ { x = 6.4857; y = 6.3816; z = -6.7035 }, (* N7 *)
+ { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9 *)
+ { x = 6.1133; y = 6.1613; z = -5.4808 }, (* C8 *)
+ { x = 10.7627; y = 3.6375; z = -6.4220 }, (* H2 *)
+ { x = 7.6031; y = 6.6390; z = -9.2733 }, (* H61 *)
+ { x = 9.1004; y = 5.9708; z = -9.7893 }, (* H62 *)
+ { x = 5.1705; y = 6.6830; z = -5.3167 }) (* H8 *)
+ )
+ )
+
+let rA04
+ = N(
+ { a= -0.5426; b= -0.8175; c=0.1929; (* dgf_base_tfo *)
+ d=0.8304; e= -0.5567; f= -0.0237;
+ g=0.1267; h=0.1473; i=0.9809;
+ tx= -0.5075; ty=8.3929; tz=0.2229 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5' *)
+ { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5' *)
+ { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+ { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4' *)
+ { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4' *)
+ { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4' *)
+ { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1' *)
+ { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1' *)
+ { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2' *)
+ { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+ { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2' *)
+ { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2' *)
+ { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3' *)
+ { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3' *)
+ { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3' *)
+ { x = 3.6343; y = 2.6680; z = 2.0783 }, (* N1 *)
+ { x = 5.4505; y = 3.9805; z = 1.2446 }, (* N3 *)
+ { x = 4.7540; y = 3.3816; z = 2.1851 }, (* C2 *)
+ { x = 4.8805; y = 3.7951; z = 0.0354 }, (* C4 *)
+ { x = 3.7416; y = 3.0925; z = -0.2305 }, (* C5 *)
+ { x = 3.0873; y = 2.4980; z = 0.8606 }, (* C6 *)
+ (A (
+ { x = 1.9600; y = 1.7805; z = 0.7462 }, (* N6 *)
+ { x = 3.4605; y = 3.1184; z = -1.5906 }, (* N7 *)
+ { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9 *)
+ { x = 4.4244; y = 3.8244; z = -2.0953 }, (* C8 *)
+ { x = 5.0814; y = 3.4352; z = 3.2234 }, (* H2 *)
+ { x = 1.5423; y = 1.6454; z = -0.1520 }, (* H61 *)
+ { x = 1.5716; y = 1.3398; z = 1.5392 }, (* H62 *)
+ { x = 4.2675; y = 3.8876; z = -3.1721 }) (* H8 *)
+ )
+ )
+
+let rA05
+ = N(
+ { a= -0.5891; b=0.0449; c=0.8068; (* dgf_base_tfo *)
+ d=0.5375; e=0.7673; f=0.3498;
+ g= -0.6034; h=0.6397; i= -0.4762;
+ tx= -0.3019; ty= -3.7679; tz= -9.5913 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5' *)
+ { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5' *)
+ { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+ { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4' *)
+ { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4' *)
+ { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4' *)
+ { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1' *)
+ { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1' *)
+ { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2' *)
+ { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+ { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2' *)
+ { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2' *)
+ { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3' *)
+ { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3' *)
+ { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3' *)
+ { x = 10.2594; y = 10.6774; z = -1.0056 }, (* N1 *)
+ { x = 9.7528; y = 8.7080; z = -2.2631 }, (* N3 *)
+ { x = 10.4471; y = 9.7876; z = -1.9791 }, (* C2 *)
+ { x = 8.7271; y = 8.5575; z = -1.3991 }, (* C4 *)
+ { x = 8.4100; y = 9.3803; z = -0.3580 }, (* C5 *)
+ { x = 9.2294; y = 10.5030; z = -0.1574 }, (* C6 *)
+ (A (
+ { x = 9.0349; y = 11.3951; z = 0.8250 }, (* N6 *)
+ { x = 7.2891; y = 8.9068; z = 0.3121 }, (* N7 *)
+ { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9 *)
+ { x = 6.9702; y = 7.8292; z = -0.3353 }, (* C8 *)
+ { x = 11.3132; y = 10.0537; z = -2.5851 }, (* H2 *)
+ { x = 8.2741; y = 11.2784; z = 1.4629 }, (* H61 *)
+ { x = 9.6733; y = 12.1368; z = 0.9529 }, (* H62 *)
+ { x = 6.0888; y = 7.3990; z = 0.1403 }) (* H8 *)
+ )
+ )
+
+let rA06
+ = N(
+ { a= -0.9815; b=0.0731; c= -0.1772; (* dgf_base_tfo *)
+ d=0.1912; e=0.3054; f= -0.9328;
+ g= -0.0141; h= -0.9494; i= -0.3137;
+ tx=5.7506; ty= -5.1944; tz=4.7470 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5' *)
+ { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5' *)
+ { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+ { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4' *)
+ { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4' *)
+ { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4' *)
+ { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1' *)
+ { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1' *)
+ { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2' *)
+ { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+ { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2' *)
+ { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2' *)
+ { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3' *)
+ { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3' *)
+ { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3' *)
+ { x = 6.6624; y = 3.5061; z = -8.2986 }, (* N1 *)
+ { x = 6.5810; y = 3.2570; z = -5.9221 }, (* N3 *)
+ { x = 6.5151; y = 2.8263; z = -7.1625 }, (* C2 *)
+ { x = 6.8364; y = 4.5817; z = -5.8882 }, (* C4 *)
+ { x = 7.0116; y = 5.4064; z = -6.9609 }, (* C5 *)
+ { x = 6.9173; y = 4.8260; z = -8.2361 }, (* C6 *)
+ (A (
+ { x = 7.0668; y = 5.5163; z = -9.3763 }, (* N6 *)
+ { x = 7.2573; y = 6.7070; z = -6.5394 }, (* N7 *)
+ { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9 *)
+ { x = 7.2238; y = 6.6275; z = -5.2453 }, (* C8 *)
+ { x = 6.3146; y = 1.7741; z = -7.3641 }, (* H2 *)
+ { x = 7.2568; y = 6.4972; z = -9.3456 }, (* H61 *)
+ { x = 7.0437; y = 5.0478; z = -10.2446 }, (* H62 *)
+ { x = 7.4108; y = 7.6227; z = -4.8418 }) (* H8 *)
+ )
+ )
+
+let rA07
+ = N(
+ { a=0.2379; b=0.1310; c= -0.9624; (* dgf_base_tfo *)
+ d= -0.5876; e= -0.7696; f= -0.2499;
+ g= -0.7734; h=0.6249; i= -0.1061;
+ tx=30.9870; ty= -26.9344; tz=42.6416 },
+ { a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+ d=0.2952; e= -0.9481; f= -0.1180;
+ g=0.5882; h=0.2777; i= -0.7595;
+ tx= -58.8919; ty= -11.3095; tz=6.0866 },
+ { a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+ d=0.9731; e= -0.0359; f= -0.2275;
+ g= -0.2290; h= -0.2532; i= -0.9399;
+ tx=3.5401; ty= -29.7913; tz=52.2796 },
+ { a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+ d= -0.1183; e=0.1805; f= -0.9764;
+ g=0.4380; h= -0.8730; i= -0.2145;
+ tx=19.9023; ty=54.8054; tz=15.2799 },
+ { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P *)
+ { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P *)
+ { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P *)
+ { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5' *)
+ { x = 39.3505; y = 8.4697; z = 42.6565 }, (* C5' *)
+ { x = 39.1377; y = 7.5433; z = 42.1230 }, (* H5' *)
+ { x = 39.7203; y = 9.3119; z = 42.0717 }, (* H5'' *)
+ { x = 38.0405; y = 8.9195; z = 43.2869 }, (* C4' *)
+ { x = 37.3687; y = 9.3036; z = 42.5193 }, (* H4' *)
+ { x = 37.4319; y = 7.8146; z = 43.9387 }, (* O4' *)
+ { x = 37.1959; y = 8.1354; z = 45.3237 }, (* C1' *)
+ { x = 36.1788; y = 8.5202; z = 45.3970 }, (* H1' *)
+ { x = 38.1721; y = 9.2328; z = 45.6504 }, (* C2' *)
+ { x = 39.1555; y = 8.7939; z = 45.8188 }, (* H2'' *)
+ { x = 37.7862; y = 10.0617; z = 46.7013 }, (* O2' *)
+ { x = 37.3087; y = 9.6229; z = 47.4092 }, (* H2' *)
+ { x = 38.1844; y = 10.0268; z = 44.3367 }, (* C3' *)
+ { x = 39.1578; y = 10.5054; z = 44.2289 }, (* H3' *)
+ { x = 37.0547; y = 10.9127; z = 44.3441 }, (* O3' *)
+ { x = 34.8811; y = 4.2072; z = 47.5784 }, (* N1 *)
+ { x = 35.1084; y = 6.1336; z = 46.1818 }, (* N3 *)
+ { x = 34.4108; y = 5.1360; z = 46.7207 }, (* C2 *)
+ { x = 36.3908; y = 6.1224; z = 46.6053 }, (* C4 *)
+ { x = 36.9819; y = 5.2334; z = 47.4697 }, (* C5 *)
+ { x = 36.1786; y = 4.1985; z = 48.0035 }, (* C6 *)
+ (A (
+ { x = 36.6103; y = 3.2749; z = 48.8452 }, (* N6 *)
+ { x = 38.3236; y = 5.5522; z = 47.6595 }, (* N7 *)
+ { x = 37.3887; y = 7.0024; z = 46.2437 }, (* N9 *)
+ { x = 38.5055; y = 6.6096; z = 46.9057 }, (* C8 *)
+ { x = 33.3553; y = 5.0152; z = 46.4771 }, (* H2 *)
+ { x = 37.5730; y = 3.2804; z = 49.1507 }, (* H61 *)
+ { x = 35.9775; y = 2.5638; z = 49.1828 }, (* H62 *)
+ { x = 39.5461; y = 6.9184; z = 47.0041 }) (* H8 *)
+ )
+ )
+
+let rA08
+ = N(
+ { a=0.1084; b= -0.0895; c= -0.9901; (* dgf_base_tfo *)
+ d=0.9789; e= -0.1638; f=0.1220;
+ g= -0.1731; h= -0.9824; i=0.0698;
+ tx= -2.9039; ty=47.2655; tz=33.0094 },
+ { a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+ d=0.2952; e= -0.9481; f= -0.1180;
+ g=0.5882; h=0.2777; i= -0.7595;
+ tx= -58.8919; ty= -11.3095; tz=6.0866 },
+ { a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+ d=0.9731; e= -0.0359; f= -0.2275;
+ g= -0.2290; h= -0.2532; i= -0.9399;
+ tx=3.5401; ty= -29.7913; tz=52.2796 },
+ { a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+ d= -0.1183; e=0.1805; f= -0.9764;
+ g=0.4380; h= -0.8730; i= -0.2145;
+ tx=19.9023; ty=54.8054; tz=15.2799 },
+ { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P *)
+ { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P *)
+ { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P *)
+ { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5' *)
+ { x = 39.4850; y = 8.9301; z = 44.6977 }, (* C5' *)
+ { x = 39.0638; y = 9.8199; z = 44.2296 }, (* H5' *)
+ { x = 40.0757; y = 9.0713; z = 45.6029 }, (* H5'' *)
+ { x = 38.3102; y = 8.0414; z = 45.0789 }, (* C4' *)
+ { x = 37.7842; y = 8.4637; z = 45.9351 }, (* H4' *)
+ { x = 37.4200; y = 7.9453; z = 43.9769 }, (* O4' *)
+ { x = 37.2249; y = 6.5609; z = 43.6273 }, (* C1' *)
+ { x = 36.3360; y = 6.2168; z = 44.1561 }, (* H1' *)
+ { x = 38.4347; y = 5.8414; z = 44.1590 }, (* C2' *)
+ { x = 39.2688; y = 5.9974; z = 43.4749 }, (* H2'' *)
+ { x = 38.2344; y = 4.4907; z = 44.4348 }, (* O2' *)
+ { x = 37.6374; y = 4.0386; z = 43.8341 }, (* H2' *)
+ { x = 38.6926; y = 6.6079; z = 45.4637 }, (* C3' *)
+ { x = 39.7585; y = 6.5640; z = 45.6877 }, (* H3' *)
+ { x = 37.8238; y = 6.0705; z = 46.4723 }, (* O3' *)
+ { x = 33.9162; y = 6.2598; z = 39.7758 }, (* N1 *)
+ { x = 34.6709; y = 6.5759; z = 42.0215 }, (* N3 *)
+ { x = 33.7257; y = 6.5186; z = 41.0858 }, (* C2 *)
+ { x = 35.8935; y = 6.3324; z = 41.5018 }, (* C4 *)
+ { x = 36.2105; y = 6.0601; z = 40.1932 }, (* C5 *)
+ { x = 35.1538; y = 6.0151; z = 39.2537 }, (* C6 *)
+ (A (
+ { x = 35.3088; y = 5.7642; z = 37.9649 }, (* N6 *)
+ { x = 37.5818; y = 5.8677; z = 40.0507 }, (* N7 *)
+ { x = 37.0932; y = 6.3197; z = 42.1810 }, (* N9 *)
+ { x = 38.0509; y = 6.0354; z = 41.2635 }, (* C8 *)
+ { x = 32.6830; y = 6.6898; z = 41.3532 }, (* H2 *)
+ { x = 36.2305; y = 5.5855; z = 37.5925 }, (* H61 *)
+ { x = 34.5056; y = 5.7512; z = 37.3528 }, (* H62 *)
+ { x = 39.1318; y = 5.8993; z = 41.2285 }) (* H8 *)
+ )
+ )
+
+let rA09
+ = N(
+ { a=0.8467; b=0.4166; c= -0.3311; (* dgf_base_tfo *)
+ d= -0.3962; e=0.9089; f=0.1303;
+ g=0.3552; h=0.0209; i=0.9346;
+ tx= -42.7319; ty= -26.6223; tz= -29.8163 },
+ { a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+ d=0.2952; e= -0.9481; f= -0.1180;
+ g=0.5882; h=0.2777; i= -0.7595;
+ tx= -58.8919; ty= -11.3095; tz=6.0866 },
+ { a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+ d=0.9731; e= -0.0359; f= -0.2275;
+ g= -0.2290; h= -0.2532; i= -0.9399;
+ tx=3.5401; ty= -29.7913; tz=52.2796 },
+ { a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+ d= -0.1183; e=0.1805; f= -0.9764;
+ g=0.4380; h= -0.8730; i= -0.2145;
+ tx=19.9023; ty=54.8054; tz=15.2799 },
+ { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P *)
+ { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P *)
+ { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P *)
+ { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5' *)
+ { x = 39.3505; y = 8.4697; z = 42.6565 }, (* C5' *)
+ { x = 39.1377; y = 7.5433; z = 42.1230 }, (* H5' *)
+ { x = 39.7203; y = 9.3119; z = 42.0717 }, (* H5'' *)
+ { x = 38.0405; y = 8.9195; z = 43.2869 }, (* C4' *)
+ { x = 37.6479; y = 8.1347; z = 43.9335 }, (* H4' *)
+ { x = 38.2691; y = 10.0933; z = 44.0524 }, (* O4' *)
+ { x = 37.3999; y = 11.1488; z = 43.5973 }, (* C1' *)
+ { x = 36.5061; y = 11.1221; z = 44.2206 }, (* H1' *)
+ { x = 37.0364; y = 10.7838; z = 42.1836 }, (* C2' *)
+ { x = 37.8636; y = 11.0489; z = 41.5252 }, (* H2'' *)
+ { x = 35.8275; y = 11.3133; z = 41.7379 }, (* O2' *)
+ { x = 35.6214; y = 12.1896; z = 42.0714 }, (* H2' *)
+ { x = 36.9316; y = 9.2556; z = 42.2837 }, (* C3' *)
+ { x = 37.1778; y = 8.8260; z = 41.3127 }, (* H3' *)
+ { x = 35.6285; y = 8.9334; z = 42.7926 }, (* O3' *)
+ { x = 38.1482; y = 15.2833; z = 46.4641 }, (* N1 *)
+ { x = 37.3641; y = 13.0968; z = 45.9007 }, (* N3 *)
+ { x = 37.5032; y = 14.1288; z = 46.7300 }, (* C2 *)
+ { x = 37.9570; y = 13.3377; z = 44.7113 }, (* C4 *)
+ { x = 38.6397; y = 14.4660; z = 44.3267 }, (* C5 *)
+ { x = 38.7473; y = 15.5229; z = 45.2609 }, (* C6 *)
+ (A (
+ { x = 39.3720; y = 16.6649; z = 45.0297 }, (* N6 *)
+ { x = 39.1079; y = 14.3351; z = 43.0223 }, (* N7 *)
+ { x = 38.0132; y = 12.4868; z = 43.6280 }, (* N9 *)
+ { x = 38.7058; y = 13.1402; z = 42.6620 }, (* C8 *)
+ { x = 37.0731; y = 14.0857; z = 47.7306 }, (* H2 *)
+ { x = 39.8113; y = 16.8281; z = 44.1350 }, (* H61 *)
+ { x = 39.4100; y = 17.3741; z = 45.7478 }, (* H62 *)
+ { x = 39.0412; y = 12.9660; z = 41.6397 }) (* H8 *)
+ )
+ )
+
+let rA10
+ = N(
+ { a=0.7063; b=0.6317; c= -0.3196; (* dgf_base_tfo *)
+ d= -0.0403; e= -0.4149; f= -0.9090;
+ g= -0.7068; h=0.6549; i= -0.2676;
+ tx=6.4402; ty= -52.1496; tz=30.8246 },
+ { a=0.7529; b=0.1548; c=0.6397; (* P_O3'_275_tfo *)
+ d=0.2952; e= -0.9481; f= -0.1180;
+ g=0.5882; h=0.2777; i= -0.7595;
+ tx= -58.8919; ty= -11.3095; tz=6.0866 },
+ { a= -0.0239; b=0.9667; c= -0.2546; (* P_O3'_180_tfo *)
+ d=0.9731; e= -0.0359; f= -0.2275;
+ g= -0.2290; h= -0.2532; i= -0.9399;
+ tx=3.5401; ty= -29.7913; tz=52.2796 },
+ { a= -0.8912; b= -0.4531; c=0.0242; (* P_O3'_60_tfo *)
+ d= -0.1183; e=0.1805; f= -0.9764;
+ g=0.4380; h= -0.8730; i= -0.2145;
+ tx=19.9023; ty=54.8054; tz=15.2799 },
+ { x = 41.8210; y = 8.3880; z = 43.5890 }, (* P *)
+ { x = 42.5400; y = 8.0450; z = 44.8330 }, (* O1P *)
+ { x = 42.2470; y = 9.6920; z = 42.9910 }, (* O2P *)
+ { x = 40.2550; y = 8.2030; z = 43.7340 }, (* O5' *)
+ { x = 39.4850; y = 8.9301; z = 44.6977 }, (* C5' *)
+ { x = 39.0638; y = 9.8199; z = 44.2296 }, (* H5' *)
+ { x = 40.0757; y = 9.0713; z = 45.6029 }, (* H5'' *)
+ { x = 38.3102; y = 8.0414; z = 45.0789 }, (* C4' *)
+ { x = 37.7099; y = 7.8166; z = 44.1973 }, (* H4' *)
+ { x = 38.8012; y = 6.8321; z = 45.6380 }, (* O4' *)
+ { x = 38.2431; y = 6.6413; z = 46.9529 }, (* C1' *)
+ { x = 37.3505; y = 6.0262; z = 46.8385 }, (* H1' *)
+ { x = 37.8484; y = 8.0156; z = 47.4214 }, (* C2' *)
+ { x = 38.7381; y = 8.5406; z = 47.7690 }, (* H2'' *)
+ { x = 36.8286; y = 8.0368; z = 48.3701 }, (* O2' *)
+ { x = 36.8392; y = 7.3063; z = 48.9929 }, (* H2' *)
+ { x = 37.3576; y = 8.6512; z = 46.1132 }, (* C3' *)
+ { x = 37.5207; y = 9.7275; z = 46.1671 }, (* H3' *)
+ { x = 35.9985; y = 8.2392; z = 45.9032 }, (* O3' *)
+ { x = 39.9117; y = 2.2278; z = 48.8527 }, (* N1 *)
+ { x = 38.6207; y = 3.6941; z = 47.4757 }, (* N3 *)
+ { x = 38.9872; y = 2.4888; z = 47.9057 }, (* C2 *)
+ { x = 39.2961; y = 4.6720; z = 48.1174 }, (* C4 *)
+ { x = 40.2546; y = 4.5307; z = 49.0912 }, (* C5 *)
+ { x = 40.5932; y = 3.2189; z = 49.4985 }, (* C6 *)
+ (A (
+ { x = 41.4938; y = 2.9317; z = 50.4229 }, (* N6 *)
+ { x = 40.7195; y = 5.7755; z = 49.5060 }, (* N7 *)
+ { x = 39.1730; y = 6.0305; z = 47.9170 }, (* N9 *)
+ { x = 40.0413; y = 6.6250; z = 48.7728 }, (* C8 *)
+ { x = 38.5257; y = 1.5960; z = 47.4838 }, (* H2 *)
+ { x = 41.9907; y = 3.6753; z = 50.8921 }, (* H61 *)
+ { x = 41.6848; y = 1.9687; z = 50.6599 }, (* H62 *)
+ { x = 40.3571; y = 7.6321; z = 49.0452 }) (* H8 *)
+ )
+ )
+
+let rAs = [rA01;rA02;rA03;rA04;rA05;rA06;rA07;rA08;rA09;rA10]
+
+let rC
+ = N(
+ { a= -0.0359; b= -0.8071; c=0.5894; (* dgf_base_tfo *)
+ d= -0.2669; e=0.5761; f=0.7726;
+ g= -0.9631; h= -0.1296; i= -0.2361;
+ tx=0.1584; ty=8.3434; tz=0.5434 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5' *)
+ { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5' *)
+ { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+ { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4' *)
+ { x = 7.2954; y = -7.6762; z = 2.4898 }, (* H4' *)
+ { x = 6.0140; y = -6.5420; z = 1.2890 }, (* O4' *)
+ { x = 6.4190; y = -5.1840; z = 1.3620 }, (* C1' *)
+ { x = 7.1608; y = -5.0495; z = 0.5747 }, (* H1' *)
+ { x = 7.0760; y = -4.9560; z = 2.7270 }, (* C2' *)
+ { x = 6.7770; y = -3.9803; z = 3.1099 }, (* H2'' *)
+ { x = 8.4500; y = -5.1930; z = 2.5810 }, (* O2' *)
+ { x = 8.8309; y = -4.8755; z = 1.7590 }, (* H2' *)
+ { x = 6.4060; y = -6.0590; z = 3.5580 }, (* C3' *)
+ { x = 5.4021; y = -5.7313; z = 3.8281 }, (* H3' *)
+ { x = 7.1570; y = -6.4240; z = 4.7070 }, (* O3' *)
+ { x = 5.2170; y = -4.3260; z = 1.1690 }, (* N1 *)
+ { x = 4.2960; y = -2.2560; z = 0.6290 }, (* N3 *)
+ { x = 5.4330; y = -3.0200; z = 0.7990 }, (* C2 *)
+ { x = 2.9930; y = -2.6780; z = 0.7940 }, (* C4 *)
+ { x = 2.8670; y = -4.0630; z = 1.1830 }, (* C5 *)
+ { x = 3.9570; y = -4.8300; z = 1.3550 }, (* C6 *)
+ (C (
+ { x = 2.0187; y = -1.8047; z = 0.5874 }, (* N4 *)
+ { x = 6.5470; y = -2.5560; z = 0.6290 }, (* O2 *)
+ { x = 1.0684; y = -2.1236; z = 0.7109 }, (* H41 *)
+ { x = 2.2344; y = -0.8560; z = 0.3162 }, (* H42 *)
+ { x = 1.8797; y = -4.4972; z = 1.3404 }, (* H5 *)
+ { x = 3.8479; y = -5.8742; z = 1.6480 }) (* H6 *)
+ )
+ )
+
+let rC01
+ = N(
+ { a= -0.0137; b= -0.8012; c=0.5983; (* dgf_base_tfo *)
+ d= -0.2523; e=0.5817; f=0.7733;
+ g= -0.9675; h= -0.1404; i= -0.2101;
+ tx=0.2031; ty=8.3874; tz=0.4228 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5' *)
+ { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5' *)
+ { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+ { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4' *)
+ { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4' *)
+ { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4' *)
+ { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1' *)
+ { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1' *)
+ { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2' *)
+ { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+ { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2' *)
+ { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2' *)
+ { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3' *)
+ { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3' *)
+ { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3' *)
+ { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1 *)
+ { x = 4.3777; y = -2.2062; z = 0.7229 }, (* N3 *)
+ { x = 5.5069; y = -2.9779; z = 0.9088 }, (* C2 *)
+ { x = 3.0693; y = -2.6246; z = 0.8500 }, (* C4 *)
+ { x = 2.9279; y = -4.0146; z = 1.2149 }, (* C5 *)
+ { x = 4.0101; y = -4.7892; z = 1.4017 }, (* C6 *)
+ (C (
+ { x = 2.1040; y = -1.7437; z = 0.6331 }, (* N4 *)
+ { x = 6.6267; y = -2.5166; z = 0.7728 }, (* O2 *)
+ { x = 1.1496; y = -2.0600; z = 0.7287 }, (* H41 *)
+ { x = 2.3303; y = -0.7921; z = 0.3815 }, (* H42 *)
+ { x = 1.9353; y = -4.4465; z = 1.3419 }, (* H5 *)
+ { x = 3.8895; y = -5.8371; z = 1.6762 }) (* H6 *)
+ )
+ )
+
+let rC02
+ = N(
+ { a=0.5141; b=0.0246; c=0.8574; (* dgf_base_tfo *)
+ d= -0.5547; e= -0.7529; f=0.3542;
+ g=0.6542; h= -0.6577; i= -0.3734;
+ tx= -9.1111; ty= -3.4598; tz= -3.2939 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5' *)
+ { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5' *)
+ { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+ { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4' *)
+ { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4' *)
+ { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4' *)
+ { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1' *)
+ { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1' *)
+ { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2' *)
+ { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+ { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2' *)
+ { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2' *)
+ { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3' *)
+ { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3' *)
+ { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3' *)
+ { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1 *)
+ { x = 8.6945; y = -8.7046; z = -0.2857 }, (* N3 *)
+ { x = 8.6943; y = -7.6514; z = 0.6066 }, (* C2 *)
+ { x = 7.7426; y = -9.6987; z = -0.3801 }, (* C4 *)
+ { x = 6.6642; y = -9.5742; z = 0.5722 }, (* C5 *)
+ { x = 6.6391; y = -8.5592; z = 1.4526 }, (* C6 *)
+ (C (
+ { x = 7.9033; y = -10.6371; z = -1.3010 }, (* N4 *)
+ { x = 9.5840; y = -6.8186; z = 0.6136 }, (* O2 *)
+ { x = 7.2009; y = -11.3604; z = -1.3619 }, (* H41 *)
+ { x = 8.7058; y = -10.6168; z = -1.9140 }, (* H42 *)
+ { x = 5.8585; y = -10.3083; z = 0.5822 }, (* H5 *)
+ { x = 5.8197; y = -8.4773; z = 2.1667 }) (* H6 *)
+ )
+ )
+
+let rC03
+ = N(
+ { a= -0.4993; b=0.0476; c=0.8651; (* dgf_base_tfo *)
+ d=0.8078; e= -0.3353; f=0.4847;
+ g=0.3132; h=0.9409; i=0.1290;
+ tx=6.2989; ty= -5.2303; tz= -3.8577 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5' *)
+ { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5' *)
+ { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+ { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4' *)
+ { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4' *)
+ { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4' *)
+ { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1' *)
+ { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1' *)
+ { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2' *)
+ { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+ { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2' *)
+ { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2' *)
+ { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3' *)
+ { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3' *)
+ { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3' *)
+ { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1 *)
+ { x = 7.9218; y = -5.5700; z = 6.8877 }, (* N3 *)
+ { x = 7.8908; y = -5.0886; z = 5.5944 }, (* C2 *)
+ { x = 6.9789; y = -6.3827; z = 7.4823 }, (* C4 *)
+ { x = 5.8742; y = -6.7319; z = 6.6202 }, (* C5 *)
+ { x = 5.8182; y = -6.2769; z = 5.3570 }, (* C6 *)
+ (C (
+ { x = 7.1702; y = -6.7511; z = 8.7402 }, (* N4 *)
+ { x = 8.7747; y = -4.3728; z = 5.1568 }, (* O2 *)
+ { x = 6.4741; y = -7.3461; z = 9.1662 }, (* H41 *)
+ { x = 7.9889; y = -6.4396; z = 9.2429 }, (* H42 *)
+ { x = 5.0736; y = -7.3713; z = 6.9922 }, (* H5 *)
+ { x = 4.9784; y = -6.5473; z = 4.7170 }) (* H6 *)
+ )
+ )
+
+let rC04
+ = N(
+ { a= -0.5669; b= -0.8012; c=0.1918; (* dgf_base_tfo *)
+ d= -0.8129; e=0.5817; f=0.0273;
+ g= -0.1334; h= -0.1404; i= -0.9811;
+ tx= -0.3279; ty=8.3874; tz=0.3355 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5' *)
+ { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5' *)
+ { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+ { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4' *)
+ { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4' *)
+ { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4' *)
+ { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1' *)
+ { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1' *)
+ { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2' *)
+ { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+ { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2' *)
+ { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2' *)
+ { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3' *)
+ { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3' *)
+ { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3' *)
+ { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1 *)
+ { x = 3.8961; y = -3.0896; z = -0.1893 }, (* N3 *)
+ { x = 5.0095; y = -3.8907; z = -0.0346 }, (* C2 *)
+ { x = 3.0480; y = -2.6632; z = 0.8116 }, (* C4 *)
+ { x = 3.4093; y = -3.1310; z = 2.1292 }, (* C5 *)
+ { x = 4.4878; y = -3.9124; z = 2.3088 }, (* C6 *)
+ (C (
+ { x = 2.0216; y = -1.8941; z = 0.4804 }, (* N4 *)
+ { x = 5.7005; y = -4.2164; z = -0.9842 }, (* O2 *)
+ { x = 1.4067; y = -1.5873; z = 1.2205 }, (* H41 *)
+ { x = 1.8721; y = -1.6319; z = -0.4835 }, (* H42 *)
+ { x = 2.8048; y = -2.8507; z = 2.9918 }, (* H5 *)
+ { x = 4.7491; y = -4.2593; z = 3.3085 }) (* H6 *)
+ )
+ )
+
+let rC05
+ = N(
+ { a= -0.6298; b=0.0246; c=0.7763; (* dgf_base_tfo *)
+ d= -0.5226; e= -0.7529; f= -0.4001;
+ g=0.5746; h= -0.6577; i=0.4870;
+ tx= -0.0208; ty= -3.4598; tz= -9.6882 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5' *)
+ { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5' *)
+ { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+ { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4' *)
+ { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4' *)
+ { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4' *)
+ { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1' *)
+ { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1' *)
+ { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2' *)
+ { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+ { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2' *)
+ { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2' *)
+ { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3' *)
+ { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3' *)
+ { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3' *)
+ { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1 *)
+ { x = 8.5977; y = -9.5977; z = 0.7329 }, (* N3 *)
+ { x = 8.5951; y = -8.5745; z = 1.6594 }, (* C2 *)
+ { x = 7.7372; y = -9.7371; z = -0.3364 }, (* C4 *)
+ { x = 6.7596; y = -8.6801; z = -0.4476 }, (* C5 *)
+ { x = 6.7338; y = -7.6721; z = 0.4408 }, (* C6 *)
+ (C (
+ { x = 7.8849; y = -10.7881; z = -1.1289 }, (* N4 *)
+ { x = 9.3993; y = -8.5377; z = 2.5743 }, (* O2 *)
+ { x = 7.2499; y = -10.8809; z = -1.9088 }, (* H41 *)
+ { x = 8.6122; y = -11.4649; z = -0.9468 }, (* H42 *)
+ { x = 6.0317; y = -8.6941; z = -1.2588 }, (* H5 *)
+ { x = 5.9901; y = -6.8809; z = 0.3459 }) (* H6 *)
+ )
+ )
+
+let rC06
+ = N(
+ { a= -0.9837; b=0.0476; c= -0.1733; (* dgf_base_tfo *)
+ d= -0.1792; e= -0.3353; f=0.9249;
+ g= -0.0141; h=0.9409; i=0.3384;
+ tx=5.7793; ty= -5.2303; tz=4.5997 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5' *)
+ { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5' *)
+ { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+ { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4' *)
+ { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4' *)
+ { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4' *)
+ { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1' *)
+ { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1' *)
+ { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2' *)
+ { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+ { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2' *)
+ { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2' *)
+ { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3' *)
+ { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3' *)
+ { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3' *)
+ { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1 *)
+ { x = 6.6920; y = -5.0495; z = 7.1354 }, (* N3 *)
+ { x = 6.6201; y = -4.5500; z = 5.8506 }, (* C2 *)
+ { x = 6.9254; y = -6.3614; z = 7.4926 }, (* C4 *)
+ { x = 7.1046; y = -7.2543; z = 6.3718 }, (* C5 *)
+ { x = 7.0391; y = -6.7951; z = 5.1106 }, (* C6 *)
+ (C (
+ { x = 6.9614; y = -6.6648; z = 8.7815 }, (* N4 *)
+ { x = 6.4083; y = -3.3696; z = 5.6340 }, (* O2 *)
+ { x = 7.1329; y = -7.6280; z = 9.0324 }, (* H41 *)
+ { x = 6.8204; y = -5.9469; z = 9.4777 }, (* H42 *)
+ { x = 7.2954; y = -8.3135; z = 6.5440 }, (* H5 *)
+ { x = 7.1753; y = -7.4798; z = 4.2735 }) (* H6 *)
+ )
+ )
+
+let rC07
+ = N(
+ { a=0.0033; b=0.2720; c= -0.9623; (* dgf_base_tfo *)
+ d=0.3013; e= -0.9179; f= -0.2584;
+ g= -0.9535; h= -0.2891; i= -0.0850;
+ tx=43.0403; ty=13.7233; tz=34.5710 },
+ { a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+ d=0.0302; e= -0.7316; f=0.6811;
+ g=0.3938; h= -0.6176; i= -0.6808;
+ tx= -48.4330; ty=26.3254; tz=13.6383 },
+ { a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+ d=0.7581; e=0.4893; f=0.4311;
+ g=0.6345; h= -0.4010; i= -0.6607;
+ tx= -31.9784; ty= -13.4285; tz=44.9650 },
+ { a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+ d= -0.6890; e=0.5694; f= -0.4484;
+ g=0.3694; h= -0.2564; i= -0.8932;
+ tx=12.1105; ty=30.8774; tz=46.0946 },
+ { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P *)
+ { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P *)
+ { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P *)
+ { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5' *)
+ { x = 30.8152; y = 11.1619; z = 46.2003 }, (* C5' *)
+ { x = 30.4519; y = 10.9454; z = 45.1957 }, (* H5' *)
+ { x = 31.0379; y = 12.2016; z = 46.4400 }, (* H5'' *)
+ { x = 29.7081; y = 10.7448; z = 47.1428 }, (* C4' *)
+ { x = 28.8710; y = 11.4416; z = 47.0982 }, (* H4' *)
+ { x = 29.2550; y = 9.4394; z = 46.8162 }, (* O4' *)
+ { x = 29.3907; y = 8.5625; z = 47.9460 }, (* C1' *)
+ { x = 28.4416; y = 8.5669; z = 48.4819 }, (* H1' *)
+ { x = 30.4468; y = 9.2031; z = 48.7952 }, (* C2' *)
+ { x = 31.4222; y = 8.9651; z = 48.3709 }, (* H2'' *)
+ { x = 30.3701; y = 8.9157; z = 50.1624 }, (* O2' *)
+ { x = 30.0652; y = 8.0304; z = 50.3740 }, (* H2' *)
+ { x = 30.1622; y = 10.6879; z = 48.6120 }, (* C3' *)
+ { x = 31.0952; y = 11.2399; z = 48.7254 }, (* H3' *)
+ { x = 29.1076; y = 11.1535; z = 49.4702 }, (* O3' *)
+ { x = 29.7883; y = 7.2209; z = 47.5235 }, (* N1 *)
+ { x = 29.1825; y = 5.0438; z = 46.8275 }, (* N3 *)
+ { x = 28.8008; y = 6.2912; z = 47.2263 }, (* C2 *)
+ { x = 30.4888; y = 4.6890; z = 46.7186 }, (* C4 *)
+ { x = 31.5034; y = 5.6405; z = 47.0249 }, (* C5 *)
+ { x = 31.1091; y = 6.8691; z = 47.4156 }, (* C6 *)
+ (C (
+ { x = 30.8109; y = 3.4584; z = 46.3336 }, (* N4 *)
+ { x = 27.6171; y = 6.5989; z = 47.3189 }, (* O2 *)
+ { x = 31.7923; y = 3.2301; z = 46.2638 }, (* H41 *)
+ { x = 30.0880; y = 2.7857; z = 46.1215 }, (* H42 *)
+ { x = 32.5542; y = 5.3634; z = 46.9395 }, (* H5 *)
+ { x = 31.8523; y = 7.6279; z = 47.6603 }) (* H6 *)
+ )
+ )
+
+let rC08
+ = N(
+ { a=0.0797; b= -0.6026; c= -0.7941; (* dgf_base_tfo *)
+ d=0.7939; e=0.5201; f= -0.3150;
+ g=0.6028; h= -0.6054; i=0.5198;
+ tx= -36.8341; ty=41.5293; tz=1.6628 },
+ { a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+ d=0.0302; e= -0.7316; f=0.6811;
+ g=0.3938; h= -0.6176; i= -0.6808;
+ tx= -48.4330; ty=26.3254; tz=13.6383 },
+ { a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+ d=0.7581; e=0.4893; f=0.4311;
+ g=0.6345; h= -0.4010; i= -0.6607;
+ tx= -31.9784; ty= -13.4285; tz=44.9650 },
+ { a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+ d= -0.6890; e=0.5694; f= -0.4484;
+ g=0.3694; h= -0.2564; i= -0.8932;
+ tx=12.1105; ty=30.8774; tz=46.0946 },
+ { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P *)
+ { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P *)
+ { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P *)
+ { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5' *)
+ { x = 31.8779; y = 9.9369; z = 47.8760 }, (* C5' *)
+ { x = 31.3239; y = 10.6931; z = 48.4322 }, (* H5' *)
+ { x = 32.8647; y = 9.6624; z = 48.2489 }, (* H5'' *)
+ { x = 31.0429; y = 8.6773; z = 47.9401 }, (* C4' *)
+ { x = 31.0779; y = 8.2331; z = 48.9349 }, (* H4' *)
+ { x = 29.6956; y = 8.9669; z = 47.5983 }, (* O4' *)
+ { x = 29.2784; y = 8.1700; z = 46.4782 }, (* C1' *)
+ { x = 28.8006; y = 7.2731; z = 46.8722 }, (* H1' *)
+ { x = 30.5544; y = 7.7940; z = 45.7875 }, (* C2' *)
+ { x = 30.8837; y = 8.6410; z = 45.1856 }, (* H2'' *)
+ { x = 30.5100; y = 6.6007; z = 45.0582 }, (* O2' *)
+ { x = 29.6694; y = 6.4168; z = 44.6326 }, (* H2' *)
+ { x = 31.5146; y = 7.5954; z = 46.9527 }, (* C3' *)
+ { x = 32.5255; y = 7.8261; z = 46.6166 }, (* H3' *)
+ { x = 31.3876; y = 6.2951; z = 47.5516 }, (* O3' *)
+ { x = 28.3976; y = 8.9302; z = 45.5933 }, (* N1 *)
+ { x = 26.2155; y = 9.6135; z = 44.9910 }, (* N3 *)
+ { x = 27.0281; y = 8.8961; z = 45.8192 }, (* C2 *)
+ { x = 26.7044; y = 10.3489; z = 43.9595 }, (* C4 *)
+ { x = 28.1088; y = 10.3837; z = 43.7247 }, (* C5 *)
+ { x = 28.8978; y = 9.6708; z = 44.5535 }, (* C6 *)
+ (C (
+ { x = 25.8715; y = 11.0249; z = 43.1749 }, (* N4 *)
+ { x = 26.5733; y = 8.2371; z = 46.7484 }, (* O2 *)
+ { x = 26.2707; y = 11.5609; z = 42.4177 }, (* H41 *)
+ { x = 24.8760; y = 10.9939; z = 43.3427 }, (* H42 *)
+ { x = 28.5089; y = 10.9722; z = 42.8990 }, (* H5 *)
+ { x = 29.9782; y = 9.6687; z = 44.4097 }) (* H6 *)
+ )
+ )
+
+let rC09
+ = N(
+ { a=0.8727; b=0.4760; c= -0.1091; (* dgf_base_tfo *)
+ d= -0.4188; e=0.6148; f= -0.6682;
+ g= -0.2510; h=0.6289; i=0.7359;
+ tx= -8.1687; ty= -52.0761; tz= -25.0726 },
+ { a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+ d=0.0302; e= -0.7316; f=0.6811;
+ g=0.3938; h= -0.6176; i= -0.6808;
+ tx= -48.4330; ty=26.3254; tz=13.6383 },
+ { a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+ d=0.7581; e=0.4893; f=0.4311;
+ g=0.6345; h= -0.4010; i= -0.6607;
+ tx= -31.9784; ty= -13.4285; tz=44.9650 },
+ { a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+ d= -0.6890; e=0.5694; f= -0.4484;
+ g=0.3694; h= -0.2564; i= -0.8932;
+ tx=12.1105; ty=30.8774; tz=46.0946 },
+ { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P *)
+ { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P *)
+ { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P *)
+ { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5' *)
+ { x = 30.8152; y = 11.1619; z = 46.2003 }, (* C5' *)
+ { x = 30.4519; y = 10.9454; z = 45.1957 }, (* H5' *)
+ { x = 31.0379; y = 12.2016; z = 46.4400 }, (* H5'' *)
+ { x = 29.7081; y = 10.7448; z = 47.1428 }, (* C4' *)
+ { x = 29.4506; y = 9.6945; z = 47.0059 }, (* H4' *)
+ { x = 30.1045; y = 10.9634; z = 48.4885 }, (* O4' *)
+ { x = 29.1794; y = 11.8418; z = 49.1490 }, (* C1' *)
+ { x = 28.4388; y = 11.2210; z = 49.6533 }, (* H1' *)
+ { x = 28.5211; y = 12.6008; z = 48.0367 }, (* C2' *)
+ { x = 29.1947; y = 13.3949; z = 47.7147 }, (* H2'' *)
+ { x = 27.2316; y = 13.0683; z = 48.3134 }, (* O2' *)
+ { x = 27.0851; y = 13.3391; z = 49.2227 }, (* H2' *)
+ { x = 28.4131; y = 11.5507; z = 46.9391 }, (* C3' *)
+ { x = 28.4451; y = 12.0512; z = 45.9713 }, (* H3' *)
+ { x = 27.2707; y = 10.6955; z = 47.1097 }, (* O3' *)
+ { x = 29.8751; y = 12.7405; z = 50.0682 }, (* N1 *)
+ { x = 30.7172; y = 13.1841; z = 52.2328 }, (* N3 *)
+ { x = 30.0617; y = 12.3404; z = 51.3847 }, (* C2 *)
+ { x = 31.1834; y = 14.3941; z = 51.8297 }, (* C4 *)
+ { x = 30.9913; y = 14.8074; z = 50.4803 }, (* C5 *)
+ { x = 30.3434; y = 13.9610; z = 49.6548 }, (* C6 *)
+ (C (
+ { x = 31.8090; y = 15.1847; z = 52.6957 }, (* N4 *)
+ { x = 29.6470; y = 11.2494; z = 51.7616 }, (* O2 *)
+ { x = 32.1422; y = 16.0774; z = 52.3606 }, (* H41 *)
+ { x = 31.9392; y = 14.8893; z = 53.6527 }, (* H42 *)
+ { x = 31.3632; y = 15.7771; z = 50.1491 }, (* H5 *)
+ { x = 30.1742; y = 14.2374; z = 48.6141 }) (* H6 *)
+ )
+ )
+
+let rC10
+ = N(
+ { a=0.1549; b=0.8710; c= -0.4663; (* dgf_base_tfo *)
+ d=0.6768; e= -0.4374; f= -0.5921;
+ g= -0.7197; h= -0.2239; i= -0.6572;
+ tx=25.2447; ty= -14.1920; tz=50.3201 },
+ { a=0.9187; b=0.2887; c=0.2694; (* P_O3'_275_tfo *)
+ d=0.0302; e= -0.7316; f=0.6811;
+ g=0.3938; h= -0.6176; i= -0.6808;
+ tx= -48.4330; ty=26.3254; tz=13.6383 },
+ { a= -0.1504; b=0.7744; c= -0.6145; (* P_O3'_180_tfo *)
+ d=0.7581; e=0.4893; f=0.4311;
+ g=0.6345; h= -0.4010; i= -0.6607;
+ tx= -31.9784; ty= -13.4285; tz=44.9650 },
+ { a= -0.6236; b= -0.7810; c= -0.0337; (* P_O3'_60_tfo *)
+ d= -0.6890; e=0.5694; f= -0.4484;
+ g=0.3694; h= -0.2564; i= -0.8932;
+ tx=12.1105; ty=30.8774; tz=46.0946 },
+ { x = 33.3400; y = 11.0980; z = 46.1750 }, (* P *)
+ { x = 34.5130; y = 10.2320; z = 46.4660 }, (* O1P *)
+ { x = 33.4130; y = 12.3960; z = 46.9340 }, (* O2P *)
+ { x = 31.9810; y = 10.3390; z = 46.4820 }, (* O5' *)
+ { x = 31.8779; y = 9.9369; z = 47.8760 }, (* C5' *)
+ { x = 31.3239; y = 10.6931; z = 48.4322 }, (* H5' *)
+ { x = 32.8647; y = 9.6624; z = 48.2489 }, (* H5'' *)
+ { x = 31.0429; y = 8.6773; z = 47.9401 }, (* C4' *)
+ { x = 30.0440; y = 8.8473; z = 47.5383 }, (* H4' *)
+ { x = 31.6749; y = 7.6351; z = 47.2119 }, (* O4' *)
+ { x = 31.9159; y = 6.5022; z = 48.0616 }, (* C1' *)
+ { x = 31.0691; y = 5.8243; z = 47.9544 }, (* H1' *)
+ { x = 31.9300; y = 7.0685; z = 49.4493 }, (* C2' *)
+ { x = 32.9024; y = 7.5288; z = 49.6245 }, (* H2'' *)
+ { x = 31.5672; y = 6.1750; z = 50.4632 }, (* O2' *)
+ { x = 31.8416; y = 5.2663; z = 50.3200 }, (* H2' *)
+ { x = 30.8618; y = 8.1514; z = 49.3749 }, (* C3' *)
+ { x = 31.1122; y = 8.9396; z = 50.0850 }, (* H3' *)
+ { x = 29.5351; y = 7.6245; z = 49.5409 }, (* O3' *)
+ { x = 33.1890; y = 5.8629; z = 47.7343 }, (* N1 *)
+ { x = 34.4004; y = 4.2636; z = 46.4828 }, (* N3 *)
+ { x = 33.2062; y = 4.8497; z = 46.7851 }, (* C2 *)
+ { x = 35.5600; y = 4.6374; z = 47.0822 }, (* C4 *)
+ { x = 35.5444; y = 5.6751; z = 48.0577 }, (* C5 *)
+ { x = 34.3565; y = 6.2450; z = 48.3432 }, (* C6 *)
+ (C (
+ { x = 36.6977; y = 4.0305; z = 46.7598 }, (* N4 *)
+ { x = 32.1661; y = 4.5034; z = 46.2348 }, (* O2 *)
+ { x = 37.5405; y = 4.3347; z = 47.2259 }, (* H41 *)
+ { x = 36.7033; y = 3.2923; z = 46.0706 }, (* H42 *)
+ { x = 36.4713; y = 5.9811; z = 48.5428 }, (* H5 *)
+ { x = 34.2986; y = 7.0426; z = 49.0839 }) (* H6 *)
+ )
+ )
+
+let rCs = [rC01;rC02;rC03;rC04;rC05;rC06;rC07;rC08;rC09;rC10]
+
+let rG
+ = N(
+ { a= -0.0018; b= -0.8207; c=0.5714; (* dgf_base_tfo *)
+ d=0.2679; e= -0.5509; f= -0.7904;
+ g=0.9634; h=0.1517; i=0.2209;
+ tx=0.0073; ty=8.4030; tz=0.6232 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4550; y = 8.2120; z = -2.8810 }, (* C5' *)
+ { x = 5.4546; y = 8.8508; z = -1.9978 }, (* H5' *)
+ { x = 5.7588; y = 8.6625; z = -3.8259 }, (* H5'' *)
+ { x = 6.4970; y = 7.1480; z = -2.5980 }, (* C4' *)
+ { x = 7.4896; y = 7.5919; z = -2.5214 }, (* H4' *)
+ { x = 6.1630; y = 6.4860; z = -1.3440 }, (* O4' *)
+ { x = 6.5400; y = 5.1200; z = -1.4190 }, (* C1' *)
+ { x = 7.2763; y = 4.9681; z = -0.6297 }, (* H1' *)
+ { x = 7.1940; y = 4.8830; z = -2.7770 }, (* C2' *)
+ { x = 6.8667; y = 3.9183; z = -3.1647 }, (* H2'' *)
+ { x = 8.5860; y = 5.0910; z = -2.6140 }, (* O2' *)
+ { x = 8.9510; y = 4.7626; z = -1.7890 }, (* H2' *)
+ { x = 6.5720; y = 6.0040; z = -3.6090 }, (* C3' *)
+ { x = 5.5636; y = 5.7066; z = -3.8966 }, (* H3' *)
+ { x = 7.3801; y = 6.3562; z = -4.7350 }, (* O3' *)
+ { x = 4.7150; y = 0.4910; z = -0.1360 }, (* N1 *)
+ { x = 6.3490; y = 2.1730; z = -0.6020 }, (* N3 *)
+ { x = 5.9530; y = 0.9650; z = -0.2670 }, (* C2 *)
+ { x = 5.2900; y = 2.9790; z = -0.8260 }, (* C4 *)
+ { x = 3.9720; y = 2.6390; z = -0.7330 }, (* C5 *)
+ { x = 3.6770; y = 1.3160; z = -0.3660 }, (* C6 *)
+ (G (
+ { x = 6.8426; y = 0.0056; z = -0.0019 }, (* N2 *)
+ { x = 3.1660; y = 3.7290; z = -1.0360 }, (* N7 *)
+ { x = 5.3170; y = 4.2990; z = -1.1930 }, (* N9 *)
+ { x = 4.0100; y = 4.6780; z = -1.2990 }, (* C8 *)
+ { x = 2.4280; y = 0.8450; z = -0.2360 }, (* O6 *)
+ { x = 4.6151; y = -0.4677; z = 0.1305 }, (* H1 *)
+ { x = 6.6463; y = -0.9463; z = 0.2729 }, (* H21 *)
+ { x = 7.8170; y = 0.2642; z = -0.0640 }, (* H22 *)
+ { x = 3.4421; y = 5.5744; z = -1.5482 }) (* H8 *)
+ )
+ )
+
+let rG01
+ = N(
+ { a= -0.0043; b= -0.8175; c=0.5759; (* dgf_base_tfo *)
+ d=0.2617; e= -0.5567; f= -0.7884;
+ g=0.9651; h=0.1473; i=0.2164;
+ tx=0.0359; ty=8.3929; tz=0.5532 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5' *)
+ { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5' *)
+ { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+ { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4' *)
+ { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4' *)
+ { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4' *)
+ { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1' *)
+ { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1' *)
+ { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2' *)
+ { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+ { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2' *)
+ { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2' *)
+ { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3' *)
+ { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3' *)
+ { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3' *)
+ { x = 4.7442; y = 0.4514; z = -0.1390 }, (* N1 *)
+ { x = 6.3687; y = 2.1459; z = -0.5926 }, (* N3 *)
+ { x = 5.9795; y = 0.9335; z = -0.2657 }, (* C2 *)
+ { x = 5.3052; y = 2.9471; z = -0.8125 }, (* C4 *)
+ { x = 3.9891; y = 2.5987; z = -0.7230 }, (* C5 *)
+ { x = 3.7016; y = 1.2717; z = -0.3647 }, (* C6 *)
+ (G (
+ { x = 6.8745; y = -0.0224; z = -0.0058 }, (* N2 *)
+ { x = 3.1770; y = 3.6859; z = -1.0198 }, (* N7 *)
+ { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9 *)
+ { x = 4.0156; y = 4.6415; z = -1.2759 }, (* C8 *)
+ { x = 2.4553; y = 0.7925; z = -0.2390 }, (* O6 *)
+ { x = 4.6497; y = -0.5095; z = 0.1212 }, (* H1 *)
+ { x = 6.6836; y = -0.9771; z = 0.2627 }, (* H21 *)
+ { x = 7.8474; y = 0.2424; z = -0.0653 }, (* H22 *)
+ { x = 3.4426; y = 5.5361; z = -1.5199 }) (* H8 *)
+ )
+ )
+
+let rG02
+ = N(
+ { a=0.5566; b=0.0449; c=0.8296; (* dgf_base_tfo *)
+ d=0.5125; e=0.7673; f= -0.3854;
+ g= -0.6538; h=0.6397; i=0.4041;
+ tx= -9.1161; ty= -3.7679; tz= -2.9968 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5' *)
+ { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5' *)
+ { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+ { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4' *)
+ { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4' *)
+ { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4' *)
+ { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1' *)
+ { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1' *)
+ { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2' *)
+ { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+ { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2' *)
+ { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2' *)
+ { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3' *)
+ { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3' *)
+ { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3' *)
+ { x = 10.3245; y = 8.5459; z = 1.5467 }, (* N1 *)
+ { x = 9.8051; y = 6.9432; z = -0.1497 }, (* N3 *)
+ { x = 10.5175; y = 7.4328; z = 0.8408 }, (* C2 *)
+ { x = 8.7523; y = 7.7422; z = -0.4228 }, (* C4 *)
+ { x = 8.4257; y = 8.9060; z = 0.2099 }, (* C5 *)
+ { x = 9.2665; y = 9.3242; z = 1.2540 }, (* C6 *)
+ (G (
+ { x = 11.6077; y = 6.7966; z = 1.2752 }, (* N2 *)
+ { x = 7.2750; y = 9.4537; z = -0.3428 }, (* N7 *)
+ { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9 *)
+ { x = 6.9479; y = 8.6157; z = -1.2771 }, (* C8 *)
+ { x = 9.0664; y = 10.4462; z = 1.9610 }, (* O6 *)
+ { x = 10.9838; y = 8.7524; z = 2.2697 }, (* H1 *)
+ { x = 12.2274; y = 7.0896; z = 2.0170 }, (* H21 *)
+ { x = 11.8502; y = 5.9398; z = 0.7984 }, (* H22 *)
+ { x = 6.0430; y = 8.9853; z = -1.7594 }) (* H8 *)
+ )
+ )
+
+let rG03
+ = N(
+ { a= -0.5021; b=0.0731; c=0.8617; (* dgf_base_tfo *)
+ d= -0.8112; e=0.3054; f= -0.4986;
+ g= -0.2996; h= -0.9494; i= -0.0940;
+ tx=6.4273; ty= -5.1944; tz= -3.7807 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5' *)
+ { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5' *)
+ { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+ { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4' *)
+ { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4' *)
+ { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4' *)
+ { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1' *)
+ { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1' *)
+ { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2' *)
+ { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+ { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2' *)
+ { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2' *)
+ { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3' *)
+ { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3' *)
+ { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3' *)
+ { x = 9.6740; y = 4.7656; z = -7.6614 }, (* N1 *)
+ { x = 9.0739; y = 4.3013; z = -5.3941 }, (* N3 *)
+ { x = 9.8416; y = 4.2192; z = -6.4581 }, (* C2 *)
+ { x = 7.9885; y = 5.0632; z = -5.6446 }, (* C4 *)
+ { x = 7.6822; y = 5.6856; z = -6.8194 }, (* C5 *)
+ { x = 8.5831; y = 5.5215; z = -7.8840 }, (* C6 *)
+ (G (
+ { x = 10.9733; y = 3.5117; z = -6.4286 }, (* N2 *)
+ { x = 6.4857; y = 6.3816; z = -6.7035 }, (* N7 *)
+ { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9 *)
+ { x = 6.1133; y = 6.1613; z = -5.4808 }, (* C8 *)
+ { x = 8.4084; y = 6.0747; z = -9.0933 }, (* O6 *)
+ { x = 10.3759; y = 4.5855; z = -8.3504 }, (* H1 *)
+ { x = 11.6254; y = 3.3761; z = -7.1879 }, (* H21 *)
+ { x = 11.1917; y = 3.0460; z = -5.5593 }, (* H22 *)
+ { x = 5.1705; y = 6.6830; z = -5.3167 }) (* H8 *)
+ )
+ )
+
+let rG04
+ = N(
+ { a= -0.5426; b= -0.8175; c=0.1929; (* dgf_base_tfo *)
+ d=0.8304; e= -0.5567; f= -0.0237;
+ g=0.1267; h=0.1473; i=0.9809;
+ tx= -0.5075; ty=8.3929; tz=0.2229 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 5.4352; y = 8.2183; z = -2.7757 }, (* C5' *)
+ { x = 5.3830; y = 8.7883; z = -1.8481 }, (* H5' *)
+ { x = 5.7729; y = 8.7436; z = -3.6691 }, (* H5'' *)
+ { x = 6.4830; y = 7.1518; z = -2.5252 }, (* C4' *)
+ { x = 7.4749; y = 7.5972; z = -2.4482 }, (* H4' *)
+ { x = 6.1626; y = 6.4620; z = -1.2827 }, (* O4' *)
+ { x = 6.5431; y = 5.0992; z = -1.3905 }, (* C1' *)
+ { x = 7.2871; y = 4.9328; z = -0.6114 }, (* H1' *)
+ { x = 7.1852; y = 4.8935; z = -2.7592 }, (* C2' *)
+ { x = 6.8573; y = 3.9363; z = -3.1645 }, (* H2'' *)
+ { x = 8.5780; y = 5.1025; z = -2.6046 }, (* O2' *)
+ { x = 8.9516; y = 4.7577; z = -1.7902 }, (* H2' *)
+ { x = 6.5522; y = 6.0300; z = -3.5612 }, (* C3' *)
+ { x = 5.5420; y = 5.7356; z = -3.8459 }, (* H3' *)
+ { x = 7.3487; y = 6.4089; z = -4.6867 }, (* O3' *)
+ { x = 3.6343; y = 2.6680; z = 2.0783 }, (* N1 *)
+ { x = 5.4505; y = 3.9805; z = 1.2446 }, (* N3 *)
+ { x = 4.7540; y = 3.3816; z = 2.1851 }, (* C2 *)
+ { x = 4.8805; y = 3.7951; z = 0.0354 }, (* C4 *)
+ { x = 3.7416; y = 3.0925; z = -0.2305 }, (* C5 *)
+ { x = 3.0873; y = 2.4980; z = 0.8606 }, (* C6 *)
+ (G (
+ { x = 5.1433; y = 3.4373; z = 3.4609 }, (* N2 *)
+ { x = 3.4605; y = 3.1184; z = -1.5906 }, (* N7 *)
+ { x = 5.3247; y = 4.2695; z = -1.1710 }, (* N9 *)
+ { x = 4.4244; y = 3.8244; z = -2.0953 }, (* C8 *)
+ { x = 1.9600; y = 1.7805; z = 0.7462 }, (* O6 *)
+ { x = 3.2489; y = 2.2879; z = 2.9191 }, (* H1 *)
+ { x = 4.6785; y = 3.0243; z = 4.2568 }, (* H21 *)
+ { x = 5.9823; y = 3.9654; z = 3.6539 }, (* H22 *)
+ { x = 4.2675; y = 3.8876; z = -3.1721 }) (* H8 *)
+ )
+ )
+
+let rG05
+ = N(
+ { a= -0.5891; b=0.0449; c=0.8068; (* dgf_base_tfo *)
+ d=0.5375; e=0.7673; f=0.3498;
+ g= -0.6034; h=0.6397; i= -0.4762;
+ tx= -0.3019; ty= -3.7679; tz= -9.5913 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.5778; y = 6.6594; z = -4.0364 }, (* C5' *)
+ { x = 4.9220; y = 7.1963; z = -4.9204 }, (* H5' *)
+ { x = 3.7996; y = 5.9091; z = -4.1764 }, (* H5'' *)
+ { x = 5.7873; y = 5.8869; z = -3.5482 }, (* C4' *)
+ { x = 6.0405; y = 5.0875; z = -4.2446 }, (* H4' *)
+ { x = 6.9135; y = 6.8036; z = -3.4310 }, (* O4' *)
+ { x = 7.7293; y = 6.4084; z = -2.3392 }, (* C1' *)
+ { x = 8.7078; y = 6.1815; z = -2.7624 }, (* H1' *)
+ { x = 7.1305; y = 5.1418; z = -1.7347 }, (* C2' *)
+ { x = 7.2040; y = 5.1982; z = -0.6486 }, (* H2'' *)
+ { x = 7.7417; y = 4.0392; z = -2.3813 }, (* O2' *)
+ { x = 8.6785; y = 4.1443; z = -2.5630 }, (* H2' *)
+ { x = 5.6666; y = 5.2728; z = -2.1536 }, (* C3' *)
+ { x = 5.1747; y = 5.9805; z = -1.4863 }, (* H3' *)
+ { x = 4.9997; y = 4.0086; z = -2.1973 }, (* O3' *)
+ { x = 10.2594; y = 10.6774; z = -1.0056 }, (* N1 *)
+ { x = 9.7528; y = 8.7080; z = -2.2631 }, (* N3 *)
+ { x = 10.4471; y = 9.7876; z = -1.9791 }, (* C2 *)
+ { x = 8.7271; y = 8.5575; z = -1.3991 }, (* C4 *)
+ { x = 8.4100; y = 9.3803; z = -0.3580 }, (* C5 *)
+ { x = 9.2294; y = 10.5030; z = -0.1574 }, (* C6 *)
+ (G (
+ { x = 11.5110; y = 10.1256; z = -2.7114 }, (* N2 *)
+ { x = 7.2891; y = 8.9068; z = 0.3121 }, (* N7 *)
+ { x = 7.7962; y = 7.5519; z = -1.3859 }, (* N9 *)
+ { x = 6.9702; y = 7.8292; z = -0.3353 }, (* C8 *)
+ { x = 9.0349; y = 11.3951; z = 0.8250 }, (* O6 *)
+ { x = 10.9013; y = 11.4422; z = -0.9512 }, (* H1 *)
+ { x = 12.1031; y = 10.9341; z = -2.5861 }, (* H21 *)
+ { x = 11.7369; y = 9.5180; z = -3.4859 }, (* H22 *)
+ { x = 6.0888; y = 7.3990; z = 0.1403 }) (* H8 *)
+ )
+ )
+
+let rG06
+ = N(
+ { a= -0.9815; b=0.0731; c= -0.1772; (* dgf_base_tfo *)
+ d=0.1912; e=0.3054; f= -0.9328;
+ g= -0.0141; h= -0.9494; i= -0.3137;
+ tx=5.7506; ty= -5.1944; tz=4.7470 },
+ { a= -0.8143; b= -0.5091; c= -0.2788; (* P_O3'_275_tfo *)
+ d= -0.0433; e= -0.4257; f=0.9038;
+ g= -0.5788; h=0.7480; i=0.3246;
+ tx=1.5227; ty=6.9114; tz= -7.0765 },
+ { a=0.3822; b= -0.7477; c=0.5430; (* P_O3'_180_tfo *)
+ d=0.4552; e=0.6637; f=0.5935;
+ g= -0.8042; h=0.0203; i=0.5941;
+ tx= -6.9472; ty= -4.1186; tz= -5.9108 },
+ { a=0.5640; b=0.8007; c= -0.2022; (* P_O3'_60_tfo *)
+ d= -0.8247; e=0.5587; f= -0.0878;
+ g=0.0426; h=0.2162; i=0.9754;
+ tx=6.2694; ty= -7.0540; tz=3.3316 },
+ { x = 2.8930; y = 8.5380; z = -3.3280 }, (* P *)
+ { x = 1.6980; y = 7.6960; z = -3.5570 }, (* O1P *)
+ { x = 3.2260; y = 9.5010; z = -4.4020 }, (* O2P *)
+ { x = 4.1590; y = 7.6040; z = -3.0340 }, (* O5' *)
+ { x = 4.1214; y = 6.7116; z = -1.9049 }, (* C5' *)
+ { x = 3.3465; y = 5.9610; z = -2.0607 }, (* H5' *)
+ { x = 4.0789; y = 7.2928; z = -0.9837 }, (* H5'' *)
+ { x = 5.4170; y = 5.9293; z = -1.8186 }, (* C4' *)
+ { x = 5.4506; y = 5.3400; z = -0.9023 }, (* H4' *)
+ { x = 5.5067; y = 5.0417; z = -2.9703 }, (* O4' *)
+ { x = 6.8650; y = 4.9152; z = -3.3612 }, (* C1' *)
+ { x = 7.1090; y = 3.8577; z = -3.2603 }, (* H1' *)
+ { x = 7.7152; y = 5.7282; z = -2.3894 }, (* C2' *)
+ { x = 8.5029; y = 6.2356; z = -2.9463 }, (* H2'' *)
+ { x = 8.1036; y = 4.8568; z = -1.3419 }, (* O2' *)
+ { x = 8.3270; y = 3.9651; z = -1.6184 }, (* H2' *)
+ { x = 6.7003; y = 6.7565; z = -1.8911 }, (* C3' *)
+ { x = 6.5898; y = 7.5329; z = -2.6482 }, (* H3' *)
+ { x = 7.0505; y = 7.2878; z = -0.6105 }, (* O3' *)
+ { x = 6.6624; y = 3.5061; z = -8.2986 }, (* N1 *)
+ { x = 6.5810; y = 3.2570; z = -5.9221 }, (* N3 *)
+ { x = 6.5151; y = 2.8263; z = -7.1625 }, (* C2 *)
+ { x = 6.8364; y = 4.5817; z = -5.8882 }, (* C4 *)
+ { x = 7.0116; y = 5.4064; z = -6.9609 }, (* C5 *)
+ { x = 6.9173; y = 4.8260; z = -8.2361 }, (* C6 *)
+ (G (
+ { x = 6.2717; y = 1.5402; z = -7.4250 }, (* N2 *)
+ { x = 7.2573; y = 6.7070; z = -6.5394 }, (* N7 *)
+ { x = 6.9740; y = 5.3703; z = -4.7760 }, (* N9 *)
+ { x = 7.2238; y = 6.6275; z = -5.2453 }, (* C8 *)
+ { x = 7.0668; y = 5.5163; z = -9.3763 }, (* O6 *)
+ { x = 6.5754; y = 2.9964; z = -9.1545 }, (* H1 *)
+ { x = 6.1908; y = 1.1105; z = -8.3354 }, (* H21 *)
+ { x = 6.1346; y = 0.9352; z = -6.6280 }, (* H22 *)
+ { x = 7.4108; y = 7.6227; z = -4.8418 }) (* H8 *)
+ )
+ )
+
+let rG07
+ = N(
+ { a=0.0894; b= -0.6059; c=0.7905; (* dgf_base_tfo *)
+ d= -0.6810; e=0.5420; f=0.4924;
+ g= -0.7268; h= -0.5824; i= -0.3642;
+ tx=34.1424; ty=45.9610; tz= -11.8600 },
+ { a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+ d= -0.0427; e=0.2409; f= -0.9696;
+ g=0.5010; h= -0.8345; i= -0.2294;
+ tx=4.0167; ty=54.5377; tz=12.4779 },
+ { a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+ d= -0.2867; e= -0.7872; f= -0.5460;
+ g=0.8834; h=0.0032; i= -0.4686;
+ tx= -52.9020; ty=18.6313; tz= -0.6709 },
+ { a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+ d=0.9040; e= -0.4236; f= -0.0582;
+ g= -0.1007; h= -0.0786; i= -0.9918;
+ tx= -7.6624; ty= -25.2080; tz=49.5181 },
+ { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P *)
+ { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P *)
+ { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P *)
+ { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5' *)
+ { x = 33.8709; y = 0.7918; z = 47.2113 }, (* C5' *)
+ { x = 34.1386; y = 0.5870; z = 46.1747 }, (* H5' *)
+ { x = 34.0186; y = -0.0095; z = 47.9353 }, (* H5'' *)
+ { x = 34.7297; y = 1.9687; z = 47.6685 }, (* C4' *)
+ { x = 35.7723; y = 1.6845; z = 47.8113 }, (* H4' *)
+ { x = 34.6455; y = 2.9768; z = 46.6660 }, (* O4' *)
+ { x = 34.1690; y = 4.1829; z = 47.2627 }, (* C1' *)
+ { x = 35.0437; y = 4.7633; z = 47.5560 }, (* H1' *)
+ { x = 33.4145; y = 3.7532; z = 48.4954 }, (* C2' *)
+ { x = 32.4340; y = 3.3797; z = 48.2001 }, (* H2'' *)
+ { x = 33.3209; y = 4.6953; z = 49.5217 }, (* O2' *)
+ { x = 33.2374; y = 5.6059; z = 49.2295 }, (* H2' *)
+ { x = 34.2724; y = 2.5970; z = 48.9773 }, (* C3' *)
+ { x = 33.6373; y = 1.8935; z = 49.5157 }, (* H3' *)
+ { x = 35.3453; y = 3.1884; z = 49.7285 }, (* O3' *)
+ { x = 34.0511; y = 7.8930; z = 43.7791 }, (* N1 *)
+ { x = 34.9937; y = 6.3369; z = 45.3199 }, (* N3 *)
+ { x = 35.0882; y = 7.3126; z = 44.4200 }, (* C2 *)
+ { x = 33.7190; y = 5.9650; z = 45.5374 }, (* C4 *)
+ { x = 32.5845; y = 6.4770; z = 44.9458 }, (* C5 *)
+ { x = 32.7430; y = 7.5179; z = 43.9914 }, (* C6 *)
+ (G (
+ { x = 36.3030; y = 7.7827; z = 44.1036 }, (* N2 *)
+ { x = 31.4499; y = 5.8335; z = 45.4368 }, (* N7 *)
+ { x = 33.2760; y = 4.9817; z = 46.4043 }, (* N9 *)
+ { x = 31.9235; y = 4.9639; z = 46.2934 }, (* C8 *)
+ { x = 31.8602; y = 8.1000; z = 43.3695 }, (* O6 *)
+ { x = 34.2623; y = 8.6223; z = 43.1283 }, (* H1 *)
+ { x = 36.5188; y = 8.5081; z = 43.4347 }, (* H21 *)
+ { x = 37.0888; y = 7.3524; z = 44.5699 }, (* H22 *)
+ { x = 31.0815; y = 4.4201; z = 46.7218 }) (* H8 *)
+ )
+ )
+
+let rG08
+ = N(
+ { a=0.2224; b=0.6335; c=0.7411; (* dgf_base_tfo *)
+ d= -0.3644; e= -0.6510; f=0.6659;
+ g=0.9043; h= -0.4181; i=0.0861;
+ tx= -47.6824; ty= -0.5823; tz= -31.7554 },
+ { a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+ d= -0.0427; e=0.2409; f= -0.9696;
+ g=0.5010; h= -0.8345; i= -0.2294;
+ tx=4.0167; ty=54.5377; tz=12.4779 },
+ { a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+ d= -0.2867; e= -0.7872; f= -0.5460;
+ g=0.8834; h=0.0032; i= -0.4686;
+ tx= -52.9020; ty=18.6313; tz= -0.6709 },
+ { a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+ d=0.9040; e= -0.4236; f= -0.0582;
+ g= -0.1007; h= -0.0786; i= -0.9918;
+ tx= -7.6624; ty= -25.2080; tz=49.5181 },
+ { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P *)
+ { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P *)
+ { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P *)
+ { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5' *)
+ { x = 32.5924; y = 2.3488; z = 48.2255 }, (* C5' *)
+ { x = 33.3674; y = 2.1246; z = 48.9584 }, (* H5' *)
+ { x = 31.5994; y = 2.5917; z = 48.6037 }, (* H5'' *)
+ { x = 33.0722; y = 3.5577; z = 47.4258 }, (* C4' *)
+ { x = 33.0310; y = 4.4778; z = 48.0089 }, (* H4' *)
+ { x = 34.4173; y = 3.3055; z = 47.0316 }, (* O4' *)
+ { x = 34.5056; y = 3.3910; z = 45.6094 }, (* C1' *)
+ { x = 34.7881; y = 4.4152; z = 45.3663 }, (* H1' *)
+ { x = 33.1122; y = 3.1198; z = 45.1010 }, (* C2' *)
+ { x = 32.9230; y = 2.0469; z = 45.1369 }, (* H2'' *)
+ { x = 32.7946; y = 3.6590; z = 43.8529 }, (* O2' *)
+ { x = 33.5170; y = 3.6707; z = 43.2207 }, (* H2' *)
+ { x = 32.2730; y = 3.8173; z = 46.1566 }, (* C3' *)
+ { x = 31.3094; y = 3.3123; z = 46.2244 }, (* H3' *)
+ { x = 32.2391; y = 5.2039; z = 45.7807 }, (* O3' *)
+ { x = 39.3337; y = 2.7157; z = 44.1441 }, (* N1 *)
+ { x = 37.4430; y = 3.8242; z = 45.0824 }, (* N3 *)
+ { x = 38.7276; y = 3.7646; z = 44.7403 }, (* C2 *)
+ { x = 36.7791; y = 2.6963; z = 44.7704 }, (* C4 *)
+ { x = 37.2860; y = 1.5653; z = 44.1678 }, (* C5 *)
+ { x = 38.6647; y = 1.5552; z = 43.8235 }, (* C6 *)
+ (G (
+ { x = 39.5123; y = 4.8216; z = 44.9936 }, (* N2 *)
+ { x = 36.2829; y = 0.6110; z = 44.0078 }, (* N7 *)
+ { x = 35.4394; y = 2.4314; z = 44.9931 }, (* N9 *)
+ { x = 35.2180; y = 1.1815; z = 44.5128 }, (* C8 *)
+ { x = 39.2907; y = 0.6514; z = 43.2796 }, (* O6 *)
+ { x = 40.3076; y = 2.8048; z = 43.9352 }, (* H1 *)
+ { x = 40.4994; y = 4.9066; z = 44.7977 }, (* H21 *)
+ { x = 39.0738; y = 5.6108; z = 45.4464 }, (* H22 *)
+ { x = 34.3856; y = 0.4842; z = 44.4185 }) (* H8 *)
+ )
+ )
+
+let rG09
+ = N(
+ { a= -0.9699; b= -0.1688; c= -0.1753; (* dgf_base_tfo *)
+ d= -0.1050; e= -0.3598; f=0.9271;
+ g= -0.2196; h=0.9176; i=0.3312;
+ tx=45.6217; ty= -38.9484; tz= -12.3208 },
+ { a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+ d= -0.0427; e=0.2409; f= -0.9696;
+ g=0.5010; h= -0.8345; i= -0.2294;
+ tx=4.0167; ty=54.5377; tz=12.4779 },
+ { a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+ d= -0.2867; e= -0.7872; f= -0.5460;
+ g=0.8834; h=0.0032; i= -0.4686;
+ tx= -52.9020; ty=18.6313; tz= -0.6709 },
+ { a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+ d=0.9040; e= -0.4236; f= -0.0582;
+ g= -0.1007; h= -0.0786; i= -0.9918;
+ tx= -7.6624; ty= -25.2080; tz=49.5181 },
+ { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P *)
+ { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P *)
+ { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P *)
+ { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5' *)
+ { x = 33.8709; y = 0.7918; z = 47.2113 }, (* C5' *)
+ { x = 34.1386; y = 0.5870; z = 46.1747 }, (* H5' *)
+ { x = 34.0186; y = -0.0095; z = 47.9353 }, (* H5'' *)
+ { x = 34.7297; y = 1.9687; z = 47.6685 }, (* C4' *)
+ { x = 34.5880; y = 2.8482; z = 47.0404 }, (* H4' *)
+ { x = 34.3575; y = 2.2770; z = 49.0081 }, (* O4' *)
+ { x = 35.5157; y = 2.1993; z = 49.8389 }, (* C1' *)
+ { x = 35.9424; y = 3.2010; z = 49.8893 }, (* H1' *)
+ { x = 36.4701; y = 1.2820; z = 49.1169 }, (* C2' *)
+ { x = 36.1545; y = 0.2498; z = 49.2683 }, (* H2'' *)
+ { x = 37.8262; y = 1.4547; z = 49.4008 }, (* O2' *)
+ { x = 38.0227; y = 1.6945; z = 50.3094 }, (* H2' *)
+ { x = 36.2242; y = 1.6797; z = 47.6725 }, (* C3' *)
+ { x = 36.4297; y = 0.8197; z = 47.0351 }, (* H3' *)
+ { x = 37.0289; y = 2.8480; z = 47.4426 }, (* O3' *)
+ { x = 34.3005; y = 3.5042; z = 54.6070 }, (* N1 *)
+ { x = 34.7693; y = 3.7936; z = 52.2874 }, (* N3 *)
+ { x = 34.4484; y = 4.2541; z = 53.4939 }, (* C2 *)
+ { x = 34.9354; y = 2.4584; z = 52.2785 }, (* C4 *)
+ { x = 34.8092; y = 1.5915; z = 53.3422 }, (* C5 *)
+ { x = 34.4646; y = 2.1367; z = 54.6085 }, (* C6 *)
+ (G (
+ { x = 34.2514; y = 5.5708; z = 53.6503 }, (* N2 *)
+ { x = 35.0641; y = 0.2835; z = 52.9337 }, (* N7 *)
+ { x = 35.2669; y = 1.6690; z = 51.1915 }, (* N9 *)
+ { x = 35.3288; y = 0.3954; z = 51.6563 }, (* C8 *)
+ { x = 34.3151; y = 1.5317; z = 55.6650 }, (* O6 *)
+ { x = 34.0623; y = 3.9797; z = 55.4539 }, (* H1 *)
+ { x = 33.9950; y = 6.0502; z = 54.5016 }, (* H21 *)
+ { x = 34.3512; y = 6.1432; z = 52.8242 }, (* H22 *)
+ { x = 35.5414; y = -0.6006; z = 51.2679 }) (* H8 *)
+ )
+ )
+
+let rG10
+ = N(
+ { a= -0.0980; b= -0.9723; c=0.2122; (* dgf_base_tfo *)
+ d= -0.9731; e=0.1383; f=0.1841;
+ g= -0.2083; h= -0.1885; i= -0.9597;
+ tx=17.8469; ty=38.8265; tz=37.0475 },
+ { a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+ d= -0.0427; e=0.2409; f= -0.9696;
+ g=0.5010; h= -0.8345; i= -0.2294;
+ tx=4.0167; ty=54.5377; tz=12.4779 },
+ { a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+ d= -0.2867; e= -0.7872; f= -0.5460;
+ g=0.8834; h=0.0032; i= -0.4686;
+ tx= -52.9020; ty=18.6313; tz= -0.6709 },
+ { a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+ d=0.9040; e= -0.4236; f= -0.0582;
+ g= -0.1007; h= -0.0786; i= -0.9918;
+ tx= -7.6624; ty= -25.2080; tz=49.5181 },
+ { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P *)
+ { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P *)
+ { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P *)
+ { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5' *)
+ { x = 32.5924; y = 2.3488; z = 48.2255 }, (* C5' *)
+ { x = 33.3674; y = 2.1246; z = 48.9584 }, (* H5' *)
+ { x = 31.5994; y = 2.5917; z = 48.6037 }, (* H5'' *)
+ { x = 33.0722; y = 3.5577; z = 47.4258 }, (* C4' *)
+ { x = 34.0333; y = 3.3761; z = 46.9447 }, (* H4' *)
+ { x = 32.0890; y = 3.8338; z = 46.4332 }, (* O4' *)
+ { x = 31.6377; y = 5.1787; z = 46.5914 }, (* C1' *)
+ { x = 32.2499; y = 5.8016; z = 45.9392 }, (* H1' *)
+ { x = 31.9167; y = 5.5319; z = 48.0305 }, (* C2' *)
+ { x = 31.1507; y = 5.0820; z = 48.6621 }, (* H2'' *)
+ { x = 32.0865; y = 6.8890; z = 48.3114 }, (* O2' *)
+ { x = 31.5363; y = 7.4819; z = 47.7942 }, (* H2' *)
+ { x = 33.2398; y = 4.8224; z = 48.2563 }, (* C3' *)
+ { x = 33.3166; y = 4.5570; z = 49.3108 }, (* H3' *)
+ { x = 34.2528; y = 5.7056; z = 47.7476 }, (* O3' *)
+ { x = 28.2782; y = 6.3049; z = 42.9364 }, (* N1 *)
+ { x = 30.4001; y = 5.8547; z = 43.9258 }, (* N3 *)
+ { x = 29.6195; y = 6.1568; z = 42.8913 }, (* C2 *)
+ { x = 29.7005; y = 5.7006; z = 45.0649 }, (* C4 *)
+ { x = 28.3383; y = 5.8221; z = 45.2343 }, (* C5 *)
+ { x = 27.5519; y = 6.1461; z = 44.0958 }, (* C6 *)
+ (G (
+ { x = 30.1838; y = 6.3385; z = 41.6890 }, (* N2 *)
+ { x = 27.9936; y = 5.5926; z = 46.5651 }, (* N7 *)
+ { x = 30.2046; y = 5.3825; z = 46.3136 }, (* N9 *)
+ { x = 29.1371; y = 5.3398; z = 47.1506 }, (* C8 *)
+ { x = 26.3361; y = 6.3024; z = 44.0495 }, (* O6 *)
+ { x = 27.8122; y = 6.5394; z = 42.0833 }, (* H1 *)
+ { x = 29.7125; y = 6.5595; z = 40.8235 }, (* H21 *)
+ { x = 31.1859; y = 6.2231; z = 41.6389 }, (* H22 *)
+ { x = 28.9406; y = 5.1504; z = 48.2059 }) (* H8 *)
+ )
+ )
+
+let rGs = [rG01;rG02;rG03;rG04;rG05;rG06;rG07;rG08;rG09;rG10]
+
+let rU
+ = N(
+ { a= -0.0359; b= -0.8071; c=0.5894; (* dgf_base_tfo *)
+ d= -0.2669; e=0.5761; f=0.7726;
+ g= -0.9631; h= -0.1296; i= -0.2361;
+ tx=0.1584; ty=8.3434; tz=0.5434 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5' *)
+ { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5' *)
+ { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+ { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4' *)
+ { x = 7.2954; y = -7.6762; z = 2.4898 }, (* H4' *)
+ { x = 6.0140; y = -6.5420; z = 1.2890 }, (* O4' *)
+ { x = 6.4190; y = -5.1840; z = 1.3620 }, (* C1' *)
+ { x = 7.1608; y = -5.0495; z = 0.5747 }, (* H1' *)
+ { x = 7.0760; y = -4.9560; z = 2.7270 }, (* C2' *)
+ { x = 6.7770; y = -3.9803; z = 3.1099 }, (* H2'' *)
+ { x = 8.4500; y = -5.1930; z = 2.5810 }, (* O2' *)
+ { x = 8.8309; y = -4.8755; z = 1.7590 }, (* H2' *)
+ { x = 6.4060; y = -6.0590; z = 3.5580 }, (* C3' *)
+ { x = 5.4021; y = -5.7313; z = 3.8281 }, (* H3' *)
+ { x = 7.1570; y = -6.4240; z = 4.7070 }, (* O3' *)
+ { x = 5.2170; y = -4.3260; z = 1.1690 }, (* N1 *)
+ { x = 4.2960; y = -2.2560; z = 0.6290 }, (* N3 *)
+ { x = 5.4330; y = -3.0200; z = 0.7990 }, (* C2 *)
+ { x = 2.9930; y = -2.6780; z = 0.7940 }, (* C4 *)
+ { x = 2.8670; y = -4.0630; z = 1.1830 }, (* C5 *)
+ { x = 3.9570; y = -4.8300; z = 1.3550 }, (* C6 *)
+ (U (
+ { x = 6.5470; y = -2.5560; z = 0.6290 }, (* O2 *)
+ { x = 2.0540; y = -1.9000; z = 0.6130 }, (* O4 *)
+ { x = 4.4300; y = -1.3020; z = 0.3600 }, (* H3 *)
+ { x = 1.9590; y = -4.4570; z = 1.3250 }, (* H5 *)
+ { x = 3.8460; y = -5.7860; z = 1.6240 }) (* H6 *)
+ )
+ )
+
+let rU01
+ = N(
+ { a= -0.0137; b= -0.8012; c=0.5983; (* dgf_base_tfo *)
+ d= -0.2523; e=0.5817; f=0.7733;
+ g= -0.9675; h= -0.1404; i= -0.2101;
+ tx=0.2031; ty=8.3874; tz=0.4228 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5' *)
+ { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5' *)
+ { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+ { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4' *)
+ { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4' *)
+ { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4' *)
+ { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1' *)
+ { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1' *)
+ { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2' *)
+ { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+ { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2' *)
+ { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2' *)
+ { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3' *)
+ { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3' *)
+ { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3' *)
+ { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1 *)
+ { x = 4.3777; y = -2.2062; z = 0.7229 }, (* N3 *)
+ { x = 5.5069; y = -2.9779; z = 0.9088 }, (* C2 *)
+ { x = 3.0693; y = -2.6246; z = 0.8500 }, (* C4 *)
+ { x = 2.9279; y = -4.0146; z = 1.2149 }, (* C5 *)
+ { x = 4.0101; y = -4.7892; z = 1.4017 }, (* C6 *)
+ (U (
+ { x = 6.6267; y = -2.5166; z = 0.7728 }, (* O2 *)
+ { x = 2.1383; y = -1.8396; z = 0.6581 }, (* O4 *)
+ { x = 4.5223; y = -1.2489; z = 0.4716 }, (* H3 *)
+ { x = 2.0151; y = -4.4065; z = 1.3290 }, (* H5 *)
+ { x = 3.8886; y = -5.7486; z = 1.6535 }) (* H6 *)
+ )
+ )
+
+let rU02
+ = N(
+ { a=0.5141; b=0.0246; c=0.8574; (* dgf_base_tfo *)
+ d= -0.5547; e= -0.7529; f=0.3542;
+ g=0.6542; h= -0.6577; i= -0.3734;
+ tx= -9.1111; ty= -3.4598; tz= -3.2939 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5' *)
+ { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5' *)
+ { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+ { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4' *)
+ { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4' *)
+ { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4' *)
+ { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1' *)
+ { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1' *)
+ { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2' *)
+ { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+ { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2' *)
+ { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2' *)
+ { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3' *)
+ { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3' *)
+ { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3' *)
+ { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1 *)
+ { x = 8.6945; y = -8.7046; z = -0.2857 }, (* N3 *)
+ { x = 8.6943; y = -7.6514; z = 0.6066 }, (* C2 *)
+ { x = 7.7426; y = -9.6987; z = -0.3801 }, (* C4 *)
+ { x = 6.6642; y = -9.5742; z = 0.5722 }, (* C5 *)
+ { x = 6.6391; y = -8.5592; z = 1.4526 }, (* C6 *)
+ (U (
+ { x = 9.5840; y = -6.8186; z = 0.6136 }, (* O2 *)
+ { x = 7.8505; y = -10.5925; z = -1.2223 }, (* O4 *)
+ { x = 9.4601; y = -8.7514; z = -0.9277 }, (* H3 *)
+ { x = 5.9281; y = -10.2509; z = 0.5782 }, (* H5 *)
+ { x = 5.8831; y = -8.4931; z = 2.1028 }) (* H6 *)
+ )
+ )
+
+let rU03
+ = N(
+ { a= -0.4993; b=0.0476; c=0.8651; (* dgf_base_tfo *)
+ d=0.8078; e= -0.3353; f=0.4847;
+ g=0.3132; h=0.9409; i=0.1290;
+ tx=6.2989; ty= -5.2303; tz= -3.8577 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5' *)
+ { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5' *)
+ { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+ { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4' *)
+ { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4' *)
+ { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4' *)
+ { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1' *)
+ { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1' *)
+ { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2' *)
+ { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+ { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2' *)
+ { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2' *)
+ { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3' *)
+ { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3' *)
+ { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3' *)
+ { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1 *)
+ { x = 7.9218; y = -5.5700; z = 6.8877 }, (* N3 *)
+ { x = 7.8908; y = -5.0886; z = 5.5944 }, (* C2 *)
+ { x = 6.9789; y = -6.3827; z = 7.4823 }, (* C4 *)
+ { x = 5.8742; y = -6.7319; z = 6.6202 }, (* C5 *)
+ { x = 5.8182; y = -6.2769; z = 5.3570 }, (* C6 *)
+ (U (
+ { x = 8.7747; y = -4.3728; z = 5.1568 }, (* O2 *)
+ { x = 7.1154; y = -6.7509; z = 8.6509 }, (* O4 *)
+ { x = 8.7055; y = -5.3037; z = 7.4491 }, (* H3 *)
+ { x = 5.1416; y = -7.3178; z = 6.9665 }, (* H5 *)
+ { x = 5.0441; y = -6.5310; z = 4.7784 }) (* H6 *)
+ )
+ )
+
+let rU04
+ = N(
+ { a= -0.5669; b= -0.8012; c=0.1918; (* dgf_base_tfo *)
+ d= -0.8129; e=0.5817; f=0.0273;
+ g= -0.1334; h= -0.1404; i= -0.9811;
+ tx= -0.3279; ty=8.3874; tz=0.3355 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2416; y = -8.2422; z = 2.8181 }, (* C5' *)
+ { x = 5.2050; y = -8.8128; z = 1.8901 }, (* H5' *)
+ { x = 5.5368; y = -8.7738; z = 3.7227 }, (* H5'' *)
+ { x = 6.3232; y = -7.2037; z = 2.6002 }, (* C4' *)
+ { x = 7.3048; y = -7.6757; z = 2.5577 }, (* H4' *)
+ { x = 6.0635; y = -6.5092; z = 1.3456 }, (* O4' *)
+ { x = 6.4697; y = -5.1547; z = 1.4629 }, (* C1' *)
+ { x = 7.2354; y = -5.0043; z = 0.7018 }, (* H1' *)
+ { x = 7.0856; y = -4.9610; z = 2.8521 }, (* C2' *)
+ { x = 6.7777; y = -3.9935; z = 3.2487 }, (* H2'' *)
+ { x = 8.4627; y = -5.1992; z = 2.7423 }, (* O2' *)
+ { x = 8.8693; y = -4.8638; z = 1.9399 }, (* H2' *)
+ { x = 6.3877; y = -6.0809; z = 3.6362 }, (* C3' *)
+ { x = 5.3770; y = -5.7562; z = 3.8834 }, (* H3' *)
+ { x = 7.1024; y = -6.4754; z = 4.7985 }, (* O3' *)
+ { x = 5.2764; y = -4.2883; z = 1.2538 }, (* N1 *)
+ { x = 3.8961; y = -3.0896; z = -0.1893 }, (* N3 *)
+ { x = 5.0095; y = -3.8907; z = -0.0346 }, (* C2 *)
+ { x = 3.0480; y = -2.6632; z = 0.8116 }, (* C4 *)
+ { x = 3.4093; y = -3.1310; z = 2.1292 }, (* C5 *)
+ { x = 4.4878; y = -3.9124; z = 2.3088 }, (* C6 *)
+ (U (
+ { x = 5.7005; y = -4.2164; z = -0.9842 }, (* O2 *)
+ { x = 2.0800; y = -1.9458; z = 0.5503 }, (* O4 *)
+ { x = 3.6834; y = -2.7882; z = -1.1190 }, (* H3 *)
+ { x = 2.8508; y = -2.8721; z = 2.9172 }, (* H5 *)
+ { x = 4.7188; y = -4.2247; z = 3.2295 }) (* H6 *)
+ )
+ )
+
+let rU05
+ = N(
+ { a= -0.6298; b=0.0246; c=0.7763; (* dgf_base_tfo *)
+ d= -0.5226; e= -0.7529; f= -0.4001;
+ g=0.5746; h= -0.6577; i=0.4870;
+ tx= -0.0208; ty= -3.4598; tz= -9.6882 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 4.3825; y = -6.6585; z = 4.0489 }, (* C5' *)
+ { x = 4.6841; y = -7.2019; z = 4.9443 }, (* H5' *)
+ { x = 3.6189; y = -5.8889; z = 4.1625 }, (* H5'' *)
+ { x = 5.6255; y = -5.9175; z = 3.5998 }, (* C4' *)
+ { x = 5.8732; y = -5.1228; z = 4.3034 }, (* H4' *)
+ { x = 6.7337; y = -6.8605; z = 3.5222 }, (* O4' *)
+ { x = 7.5932; y = -6.4923; z = 2.4548 }, (* C1' *)
+ { x = 8.5661; y = -6.2983; z = 2.9064 }, (* H1' *)
+ { x = 7.0527; y = -5.2012; z = 1.8322 }, (* C2' *)
+ { x = 7.1627; y = -5.2525; z = 0.7490 }, (* H2'' *)
+ { x = 7.6666; y = -4.1249; z = 2.4880 }, (* O2' *)
+ { x = 8.5944; y = -4.2543; z = 2.6981 }, (* H2' *)
+ { x = 5.5661; y = -5.3029; z = 2.2009 }, (* C3' *)
+ { x = 5.0841; y = -6.0018; z = 1.5172 }, (* H3' *)
+ { x = 4.9062; y = -4.0452; z = 2.2042 }, (* O3' *)
+ { x = 7.6298; y = -7.6136; z = 1.4752 }, (* N1 *)
+ { x = 8.5977; y = -9.5977; z = 0.7329 }, (* N3 *)
+ { x = 8.5951; y = -8.5745; z = 1.6594 }, (* C2 *)
+ { x = 7.7372; y = -9.7371; z = -0.3364 }, (* C4 *)
+ { x = 6.7596; y = -8.6801; z = -0.4476 }, (* C5 *)
+ { x = 6.7338; y = -7.6721; z = 0.4408 }, (* C6 *)
+ (U (
+ { x = 9.3993; y = -8.5377; z = 2.5743 }, (* O2 *)
+ { x = 7.8374; y = -10.6990; z = -1.1008 }, (* O4 *)
+ { x = 9.2924; y = -10.3081; z = 0.8477 }, (* H3 *)
+ { x = 6.0932; y = -8.6982; z = -1.1929 }, (* H5 *)
+ { x = 6.0481; y = -6.9515; z = 0.3446 }) (* H6 *)
+ )
+ )
+
+let rU06
+ = N(
+ { a= -0.9837; b=0.0476; c= -0.1733; (* dgf_base_tfo *)
+ d= -0.1792; e= -0.3353; f=0.9249;
+ g= -0.0141; h=0.9409; i=0.3384;
+ tx=5.7793; ty= -5.2303; tz=4.5997 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 3.9938; y = -6.7042; z = 1.9023 }, (* C5' *)
+ { x = 3.2332; y = -5.9343; z = 2.0319 }, (* H5' *)
+ { x = 3.9666; y = -7.2863; z = 0.9812 }, (* H5'' *)
+ { x = 5.3098; y = -5.9546; z = 1.8564 }, (* C4' *)
+ { x = 5.3863; y = -5.3702; z = 0.9395 }, (* H4' *)
+ { x = 5.3851; y = -5.0642; z = 3.0076 }, (* O4' *)
+ { x = 6.7315; y = -4.9724; z = 3.4462 }, (* C1' *)
+ { x = 7.0033; y = -3.9202; z = 3.3619 }, (* H1' *)
+ { x = 7.5997; y = -5.8018; z = 2.4948 }, (* C2' *)
+ { x = 8.3627; y = -6.3254; z = 3.0707 }, (* H2'' *)
+ { x = 8.0410; y = -4.9501; z = 1.4724 }, (* O2' *)
+ { x = 8.2781; y = -4.0644; z = 1.7570 }, (* H2' *)
+ { x = 6.5701; y = -6.8129; z = 1.9714 }, (* C3' *)
+ { x = 6.4186; y = -7.5809; z = 2.7299 }, (* H3' *)
+ { x = 6.9357; y = -7.3841; z = 0.7235 }, (* O3' *)
+ { x = 6.8024; y = -5.4718; z = 4.8475 }, (* N1 *)
+ { x = 6.6920; y = -5.0495; z = 7.1354 }, (* N3 *)
+ { x = 6.6201; y = -4.5500; z = 5.8506 }, (* C2 *)
+ { x = 6.9254; y = -6.3614; z = 7.4926 }, (* C4 *)
+ { x = 7.1046; y = -7.2543; z = 6.3718 }, (* C5 *)
+ { x = 7.0391; y = -6.7951; z = 5.1106 }, (* C6 *)
+ (U (
+ { x = 6.4083; y = -3.3696; z = 5.6340 }, (* O2 *)
+ { x = 6.9679; y = -6.6901; z = 8.6800 }, (* O4 *)
+ { x = 6.5626; y = -4.3957; z = 7.8812 }, (* H3 *)
+ { x = 7.2781; y = -8.2254; z = 6.5350 }, (* H5 *)
+ { x = 7.1657; y = -7.4312; z = 4.3503 }) (* H6 *)
+ )
+ )
+
+let rU07
+ = N(
+ { a= -0.9434; b=0.3172; c=0.0971; (* dgf_base_tfo *)
+ d=0.2294; e=0.4125; f=0.8816;
+ g=0.2396; h=0.8539; i= -0.4619;
+ tx=8.3625; ty= -52.7147; tz=1.3745 },
+ { a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+ d= -0.8297; e=0.4733; f= -0.2959;
+ g=0.4850; h=0.8737; i=0.0379;
+ tx= -14.7774; ty= -45.2464; tz=21.9088 },
+ { a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+ d= -0.5932; e= -0.6591; f=0.4624;
+ g= -0.7980; h=0.4055; i= -0.4458;
+ tx=43.7634; ty=4.3296; tz=28.4890 },
+ { a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+ d=0.6803; e=0.3317; f=0.6536;
+ g= -0.1673; h= -0.7979; i=0.5791;
+ tx= -17.1858; ty=41.4390; tz= -27.0751 },
+ { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P *)
+ { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P *)
+ { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P *)
+ { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5' *)
+ { x = 21.5037; y = 16.8594; z = 43.7323 }, (* C5' *)
+ { x = 20.8147; y = 17.6663; z = 43.9823 }, (* H5' *)
+ { x = 21.1086; y = 16.0230; z = 43.1557 }, (* H5'' *)
+ { x = 22.5654; y = 17.4874; z = 42.8616 }, (* C4' *)
+ { x = 22.1584; y = 17.7243; z = 41.8785 }, (* H4' *)
+ { x = 23.0557; y = 18.6826; z = 43.4751 }, (* O4' *)
+ { x = 24.4788; y = 18.6151; z = 43.6455 }, (* C1' *)
+ { x = 24.9355; y = 19.0840; z = 42.7739 }, (* H1' *)
+ { x = 24.7958; y = 17.1427; z = 43.6474 }, (* C2' *)
+ { x = 24.5652; y = 16.7400; z = 44.6336 }, (* H2'' *)
+ { x = 26.1041; y = 16.8773; z = 43.2455 }, (* O2' *)
+ { x = 26.7516; y = 17.5328; z = 43.5149 }, (* H2' *)
+ { x = 23.8109; y = 16.5979; z = 42.6377 }, (* C3' *)
+ { x = 23.5756; y = 15.5686; z = 42.9084 }, (* H3' *)
+ { x = 24.2890; y = 16.7447; z = 41.2729 }, (* O3' *)
+ { x = 24.9420; y = 19.2174; z = 44.8923 }, (* N1 *)
+ { x = 25.2655; y = 20.5636; z = 44.8883 }, (* N3 *)
+ { x = 25.1663; y = 21.2219; z = 43.8561 }, (* C2 *)
+ { x = 25.6911; y = 21.1219; z = 46.0494 }, (* C4 *)
+ { x = 25.8051; y = 20.4068; z = 47.2048 }, (* C5 *)
+ { x = 26.2093; y = 20.9962; z = 48.2534 }, (* C6 *)
+ (U (
+ { x = 25.4692; y = 19.0221; z = 47.2053 }, (* O2 *)
+ { x = 25.0502; y = 18.4827; z = 46.0370 }, (* O4 *)
+ { x = 25.9599; y = 22.1772; z = 46.0966 }, (* H3 *)
+ { x = 25.5545; y = 18.4409; z = 48.1234 }, (* H5 *)
+ { x = 24.7854; y = 17.4265; z = 45.9883 }) (* H6 *)
+ )
+ )
+
+let rU08
+ = N(
+ { a= -0.0080; b= -0.7928; c=0.6094; (* dgf_base_tfo *)
+ d= -0.7512; e=0.4071; f=0.5197;
+ g= -0.6601; h= -0.4536; i= -0.5988;
+ tx=44.1482; ty=30.7036; tz=2.1088 },
+ { a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+ d= -0.8297; e=0.4733; f= -0.2959;
+ g=0.4850; h=0.8737; i=0.0379;
+ tx= -14.7774; ty= -45.2464; tz=21.9088 },
+ { a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+ d= -0.5932; e= -0.6591; f=0.4624;
+ g= -0.7980; h=0.4055; i= -0.4458;
+ tx=43.7634; ty=4.3296; tz=28.4890 },
+ { a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+ d=0.6803; e=0.3317; f=0.6536;
+ g= -0.1673; h= -0.7979; i=0.5791;
+ tx= -17.1858; ty=41.4390; tz= -27.0751 },
+ { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P *)
+ { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P *)
+ { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P *)
+ { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5' *)
+ { x = 23.5096; y = 16.1227; z = 44.5783 }, (* C5' *)
+ { x = 23.5649; y = 15.8588; z = 43.5222 }, (* H5' *)
+ { x = 23.9621; y = 15.4341; z = 45.2919 }, (* H5'' *)
+ { x = 24.2805; y = 17.4138; z = 44.7151 }, (* C4' *)
+ { x = 25.3492; y = 17.2309; z = 44.6030 }, (* H4' *)
+ { x = 23.8497; y = 18.3471; z = 43.7208 }, (* O4' *)
+ { x = 23.4090; y = 19.5681; z = 44.3321 }, (* C1' *)
+ { x = 24.2595; y = 20.2496; z = 44.3524 }, (* H1' *)
+ { x = 23.0418; y = 19.1813; z = 45.7407 }, (* C2' *)
+ { x = 22.0532; y = 18.7224; z = 45.7273 }, (* H2'' *)
+ { x = 23.1307; y = 20.2521; z = 46.6291 }, (* O2' *)
+ { x = 22.8888; y = 21.1051; z = 46.2611 }, (* H2' *)
+ { x = 24.0799; y = 18.1326; z = 46.0700 }, (* C3' *)
+ { x = 23.6490; y = 17.4370; z = 46.7900 }, (* H3' *)
+ { x = 25.3329; y = 18.7227; z = 46.5109 }, (* O3' *)
+ { x = 22.2515; y = 20.1624; z = 43.6698 }, (* N1 *)
+ { x = 22.4760; y = 21.0609; z = 42.6406 }, (* N3 *)
+ { x = 23.6229; y = 21.3462; z = 42.3061 }, (* C2 *)
+ { x = 21.3986; y = 21.6081; z = 42.0236 }, (* C4 *)
+ { x = 20.1189; y = 21.3012; z = 42.3804 }, (* C5 *)
+ { x = 19.1599; y = 21.8516; z = 41.7578 }, (* C6 *)
+ (U (
+ { x = 19.8919; y = 20.3745; z = 43.4387 }, (* O2 *)
+ { x = 20.9790; y = 19.8423; z = 44.0440 }, (* O4 *)
+ { x = 21.5235; y = 22.3222; z = 41.2097 }, (* H3 *)
+ { x = 18.8732; y = 20.1200; z = 43.7312 }, (* H5 *)
+ { x = 20.8545; y = 19.1313; z = 44.8608 }) (* H6 *)
+ )
+ )
+
+let rU09
+ = N(
+ { a= -0.0317; b=0.1374; c=0.9900; (* dgf_base_tfo *)
+ d= -0.3422; e= -0.9321; f=0.1184;
+ g=0.9391; h= -0.3351; i=0.0765;
+ tx= -32.1929; ty=25.8198; tz= -28.5088 },
+ { a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+ d= -0.8297; e=0.4733; f= -0.2959;
+ g=0.4850; h=0.8737; i=0.0379;
+ tx= -14.7774; ty= -45.2464; tz=21.9088 },
+ { a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+ d= -0.5932; e= -0.6591; f=0.4624;
+ g= -0.7980; h=0.4055; i= -0.4458;
+ tx=43.7634; ty=4.3296; tz=28.4890 },
+ { a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+ d=0.6803; e=0.3317; f=0.6536;
+ g= -0.1673; h= -0.7979; i=0.5791;
+ tx= -17.1858; ty=41.4390; tz= -27.0751 },
+ { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P *)
+ { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P *)
+ { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P *)
+ { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5' *)
+ { x = 21.5037; y = 16.8594; z = 43.7323 }, (* C5' *)
+ { x = 20.8147; y = 17.6663; z = 43.9823 }, (* H5' *)
+ { x = 21.1086; y = 16.0230; z = 43.1557 }, (* H5'' *)
+ { x = 22.5654; y = 17.4874; z = 42.8616 }, (* C4' *)
+ { x = 23.0565; y = 18.3036; z = 43.3915 }, (* H4' *)
+ { x = 23.5375; y = 16.5054; z = 42.4925 }, (* O4' *)
+ { x = 23.6574; y = 16.4257; z = 41.0649 }, (* C1' *)
+ { x = 24.4701; y = 17.0882; z = 40.7671 }, (* H1' *)
+ { x = 22.3525; y = 16.9643; z = 40.5396 }, (* C2' *)
+ { x = 21.5993; y = 16.1799; z = 40.6133 }, (* H2'' *)
+ { x = 22.4693; y = 17.4849; z = 39.2515 }, (* O2' *)
+ { x = 23.0899; y = 17.0235; z = 38.6827 }, (* H2' *)
+ { x = 22.0341; y = 18.0633; z = 41.5279 }, (* C3' *)
+ { x = 20.9509; y = 18.1709; z = 41.5846 }, (* H3' *)
+ { x = 22.7249; y = 19.3020; z = 41.2100 }, (* O3' *)
+ { x = 23.8580; y = 15.0648; z = 40.5757 }, (* N1 *)
+ { x = 25.1556; y = 14.5982; z = 40.4523 }, (* N3 *)
+ { x = 26.1047; y = 15.3210; z = 40.7448 }, (* C2 *)
+ { x = 25.3391; y = 13.3315; z = 40.0020 }, (* C4 *)
+ { x = 24.2974; y = 12.5148; z = 39.6749 }, (* C5 *)
+ { x = 24.5450; y = 11.3410; z = 39.2610 }, (* C6 *)
+ (U (
+ { x = 22.9633; y = 12.9979; z = 39.8053 }, (* O2 *)
+ { x = 22.8009; y = 14.2648; z = 40.2524 }, (* O4 *)
+ { x = 26.3414; y = 12.9194; z = 39.8855 }, (* H3 *)
+ { x = 22.1227; y = 12.3533; z = 39.5486 }, (* H5 *)
+ { x = 21.7989; y = 14.6788; z = 40.3650 }) (* H6 *)
+ )
+ )
+
+let rU10
+ = N(
+ { a= -0.9674; b=0.1021; c= -0.2318; (* dgf_base_tfo *)
+ d= -0.2514; e= -0.2766; f=0.9275;
+ g=0.0306; h=0.9555; i=0.2933;
+ tx=27.8571; ty= -42.1305; tz= -24.4563 },
+ { a=0.2765; b= -0.1121; c= -0.9545; (* P_O3'_275_tfo *)
+ d= -0.8297; e=0.4733; f= -0.2959;
+ g=0.4850; h=0.8737; i=0.0379;
+ tx= -14.7774; ty= -45.2464; tz=21.9088 },
+ { a=0.1063; b= -0.6334; c= -0.7665; (* P_O3'_180_tfo *)
+ d= -0.5932; e= -0.6591; f=0.4624;
+ g= -0.7980; h=0.4055; i= -0.4458;
+ tx=43.7634; ty=4.3296; tz=28.4890 },
+ { a=0.7136; b= -0.5032; c= -0.4873; (* P_O3'_60_tfo *)
+ d=0.6803; e=0.3317; f=0.6536;
+ g= -0.1673; h= -0.7979; i=0.5791;
+ tx= -17.1858; ty=41.4390; tz= -27.0751 },
+ { x = 21.3880; y = 15.0780; z = 45.5770 }, (* P *)
+ { x = 21.9980; y = 14.5500; z = 46.8210 }, (* O1P *)
+ { x = 21.1450; y = 14.0270; z = 44.5420 }, (* O2P *)
+ { x = 22.1250; y = 16.3600; z = 44.9460 }, (* O5' *)
+ { x = 23.5096; y = 16.1227; z = 44.5783 }, (* C5' *)
+ { x = 23.5649; y = 15.8588; z = 43.5222 }, (* H5' *)
+ { x = 23.9621; y = 15.4341; z = 45.2919 }, (* H5'' *)
+ { x = 24.2805; y = 17.4138; z = 44.7151 }, (* C4' *)
+ { x = 23.8509; y = 18.1819; z = 44.0720 }, (* H4' *)
+ { x = 24.2506; y = 17.8583; z = 46.0741 }, (* O4' *)
+ { x = 25.5830; y = 18.0320; z = 46.5775 }, (* C1' *)
+ { x = 25.8569; y = 19.0761; z = 46.4256 }, (* H1' *)
+ { x = 26.4410; y = 17.1555; z = 45.7033 }, (* C2' *)
+ { x = 26.3459; y = 16.1253; z = 46.0462 }, (* H2'' *)
+ { x = 27.7649; y = 17.5888; z = 45.6478 }, (* O2' *)
+ { x = 28.1004; y = 17.9719; z = 46.4616 }, (* H2' *)
+ { x = 25.7796; y = 17.2997; z = 44.3513 }, (* C3' *)
+ { x = 25.9478; y = 16.3824; z = 43.7871 }, (* H3' *)
+ { x = 26.2154; y = 18.4984; z = 43.6541 }, (* O3' *)
+ { x = 25.7321; y = 17.6281; z = 47.9726 }, (* N1 *)
+ { x = 25.5136; y = 18.5779; z = 48.9560 }, (* N3 *)
+ { x = 25.2079; y = 19.7276; z = 48.6503 }, (* C2 *)
+ { x = 25.6482; y = 18.1987; z = 50.2518 }, (* C4 *)
+ { x = 25.9847; y = 16.9266; z = 50.6092 }, (* C5 *)
+ { x = 26.0918; y = 16.6439; z = 51.8416 }, (* C6 *)
+ (U (
+ { x = 26.2067; y = 15.9515; z = 49.5943 }, (* O2 *)
+ { x = 26.0713; y = 16.3497; z = 48.3080 }, (* O4 *)
+ { x = 25.4890; y = 18.9105; z = 51.0618 }, (* H3 *)
+ { x = 26.4742; y = 14.9310; z = 49.8682 }, (* H5 *)
+ { x = 26.2346; y = 15.6394; z = 47.4975 }) (* H6 *)
+ )
+ )
+
+let rUs = [rU01;rU02;rU03;rU04;rU05;rU06;rU07;rU08;rU09;rU10]
+
+let rG'
+ = N(
+ { a= -0.2067; b= -0.0264; c=0.9780; (* dgf_base_tfo *)
+ d=0.9770; e= -0.0586; f=0.2049;
+ g=0.0519; h=0.9979; i=0.0379;
+ tx=1.0331; ty= -46.8078; tz= -36.4742 },
+ { a= -0.8644; b= -0.4956; c= -0.0851; (* P_O3'_275_tfo *)
+ d= -0.0427; e=0.2409; f= -0.9696;
+ g=0.5010; h= -0.8345; i= -0.2294;
+ tx=4.0167; ty=54.5377; tz=12.4779 },
+ { a=0.3706; b= -0.6167; c=0.6945; (* P_O3'_180_tfo *)
+ d= -0.2867; e= -0.7872; f= -0.5460;
+ g=0.8834; h=0.0032; i= -0.4686;
+ tx= -52.9020; ty=18.6313; tz= -0.6709 },
+ { a=0.4155; b=0.9025; c= -0.1137; (* P_O3'_60_tfo *)
+ d=0.9040; e= -0.4236; f= -0.0582;
+ g= -0.1007; h= -0.0786; i= -0.9918;
+ tx= -7.6624; ty= -25.2080; tz=49.5181 },
+ { x = 31.3810; y = 0.1400; z = 47.5810 }, (* P *)
+ { x = 29.9860; y = 0.6630; z = 47.6290 }, (* O1P *)
+ { x = 31.7210; y = -0.6460; z = 48.8090 }, (* O2P *)
+ { x = 32.4940; y = 1.2540; z = 47.2740 }, (* O5' *)
+ { x = 32.1610; y = 2.2370; z = 46.2560 }, (* C5' *)
+ { x = 31.2986; y = 2.8190; z = 46.5812 }, (* H5' *)
+ { x = 32.0980; y = 1.7468; z = 45.2845 }, (* H5'' *)
+ { x = 33.3476; y = 3.1959; z = 46.1947 }, (* C4' *)
+ { x = 33.2668; y = 3.8958; z = 45.3630 }, (* H4' *)
+ { x = 33.3799; y = 3.9183; z = 47.4216 }, (* O4' *)
+ { x = 34.6515; y = 3.7222; z = 48.0398 }, (* C1' *)
+ { x = 35.2947; y = 4.5412; z = 47.7180 }, (* H1' *)
+ { x = 35.1756; y = 2.4228; z = 47.4827 }, (* C2' *)
+ { x = 34.6778; y = 1.5937; z = 47.9856 }, (* H2'' *)
+ { x = 36.5631; y = 2.2672; z = 47.4798 }, (* O2' *)
+ { x = 37.0163; y = 2.6579; z = 48.2305 }, (* H2' *)
+ { x = 34.6953; y = 2.5043; z = 46.0448 }, (* C3' *)
+ { x = 34.5444; y = 1.4917; z = 45.6706 }, (* H3' *)
+ { x = 35.6679; y = 3.3009; z = 45.3487 }, (* O3' *)
+ { x = 37.4804; y = 4.0914; z = 52.2559 }, (* N1 *)
+ { x = 36.9670; y = 4.1312; z = 49.9281 }, (* N3 *)
+ { x = 37.8045; y = 4.2519; z = 50.9550 }, (* C2 *)
+ { x = 35.7171; y = 3.8264; z = 50.3222 }, (* C4 *)
+ { x = 35.2668; y = 3.6420; z = 51.6115 }, (* C5 *)
+ { x = 36.2037; y = 3.7829; z = 52.6706 }, (* C6 *)
+ (G (
+ { x = 39.0869; y = 4.5552; z = 50.7092 }, (* N2 *)
+ { x = 33.9075; y = 3.3338; z = 51.6102 }, (* N7 *)
+ { x = 34.6126; y = 3.6358; z = 49.5108 }, (* N9 *)
+ { x = 33.5805; y = 3.3442; z = 50.3425 }, (* C8 *)
+ { x = 35.9958; y = 3.6512; z = 53.8724 }, (* O6 *)
+ { x = 38.2106; y = 4.2053; z = 52.9295 }, (* H1 *)
+ { x = 39.8218; y = 4.6863; z = 51.3896 }, (* H21 *)
+ { x = 39.3420; y = 4.6857; z = 49.7407 }, (* H22 *)
+ { x = 32.5194; y = 3.1070; z = 50.2664 }) (* H8 *)
+ )
+ )
+
+let rU'
+ = N(
+ { a= -0.0109; b=0.5907; c=0.8068; (* dgf_base_tfo *)
+ d=0.2217; e= -0.7853; f=0.5780;
+ g=0.9751; h=0.1852; i= -0.1224;
+ tx= -1.4225; ty= -11.0956; tz= -2.5217 },
+ { a= -0.8313; b= -0.4738; c= -0.2906; (* P_O3'_275_tfo *)
+ d=0.0649; e=0.4366; f= -0.8973;
+ g=0.5521; h= -0.7648; i= -0.3322;
+ tx=1.6833; ty=6.8060; tz= -7.0011 },
+ { a=0.3445; b= -0.7630; c=0.5470; (* P_O3'_180_tfo *)
+ d= -0.4628; e= -0.6450; f= -0.6082;
+ g=0.8168; h= -0.0436; i= -0.5753;
+ tx= -6.8179; ty= -3.9778; tz= -5.9887 },
+ { a=0.5855; b=0.7931; c= -0.1682; (* P_O3'_60_tfo *)
+ d=0.8103; e= -0.5790; f=0.0906;
+ g= -0.0255; h= -0.1894; i= -0.9816;
+ tx=6.1203; ty= -7.1051; tz=3.1984 },
+ { x = 2.6760; y = -8.4960; z = 3.2880 }, (* P *)
+ { x = 1.4950; y = -7.6230; z = 3.4770 }, (* O1P *)
+ { x = 2.9490; y = -9.4640; z = 4.3740 }, (* O2P *)
+ { x = 3.9730; y = -7.5950; z = 3.0340 }, (* O5' *)
+ { x = 5.2430; y = -8.2420; z = 2.8260 }, (* C5' *)
+ { x = 5.1974; y = -8.8497; z = 1.9223 }, (* H5' *)
+ { x = 5.5548; y = -8.7348; z = 3.7469 }, (* H5'' *)
+ { x = 6.3140; y = -7.2060; z = 2.5510 }, (* C4' *)
+ { x = 5.8744; y = -6.2116; z = 2.4731 }, (* H4' *)
+ { x = 7.2798; y = -7.2260; z = 3.6420 }, (* O4' *)
+ { x = 8.5733; y = -6.9410; z = 3.1329 }, (* C1' *)
+ { x = 8.9047; y = -6.0374; z = 3.6446 }, (* H1' *)
+ { x = 8.4429; y = -6.6596; z = 1.6327 }, (* C2' *)
+ { x = 9.2880; y = -7.1071; z = 1.1096 }, (* H2'' *)
+ { x = 8.2502; y = -5.2799; z = 1.4754 }, (* O2' *)
+ { x = 8.7676; y = -4.7284; z = 2.0667 }, (* H2' *)
+ { x = 7.1642; y = -7.4416; z = 1.3021 }, (* C3' *)
+ { x = 7.4125; y = -8.5002; z = 1.2260 }, (* H3' *)
+ { x = 6.5160; y = -6.9772; z = 0.1267 }, (* O3' *)
+ { x = 9.4531; y = -8.1107; z = 3.4087 }, (* N1 *)
+ { x = 11.5931; y = -9.0015; z = 3.6357 }, (* N3 *)
+ { x = 10.8101; y = -7.8950; z = 3.3748 }, (* C2 *)
+ { x = 11.1439; y = -10.2744; z = 3.9206 }, (* C4 *)
+ { x = 9.7056; y = -10.4026; z = 3.9332 }, (* C5 *)
+ { x = 8.9192; y = -9.3419; z = 3.6833 }, (* C6 *)
+ (U (
+ { x = 11.3013; y = -6.8063; z = 3.1326 }, (* O2 *)
+ { x = 11.9431; y = -11.1876; z = 4.1375 }, (* O4 *)
+ { x = 12.5840; y = -8.8673; z = 3.6158 }, (* H3 *)
+ { x = 9.2891; y = -11.2898; z = 4.1313 }, (* H5 *)
+ { x = 7.9263; y = -9.4537; z = 3.6977 }) (* H6 *)
+ )
+ )
+
+(* -- PARTIAL INSTANTIATIONS ------------------------------------------------*)
+
+type variable =
+ { id : int;
+ t : tfo;
+ n : nuc }
+
+let mk_var i t n = { id = i; t = t; n = n }
+
+let absolute_pos v p = tfo_apply v.t p
+
+let atom_pos atom v = absolute_pos v (atom v.n)
+
+let rec get_var id = function
+ | (v::lst) -> if id = v.id then v else get_var id lst
+ | _ -> assert false
+
+(* -- SEARCH ----------------------------------------------------------------*)
+
+(* Sequential backtracking algorithm *)
+
+let rec search (partial_inst : variable list) l constr =
+ match l with
+ [] -> [partial_inst]
+ | (h::t) ->
+ let rec try_assignments = function
+ [] -> []
+ | v::vs ->
+ if constr v partial_inst then
+ (search (v::partial_inst) t constr) @ (try_assignments vs)
+ else
+ try_assignments vs
+ in
+ try_assignments (h partial_inst)
+
+
+(* -- DOMAINS ---------------------------------------------------------------*)
+
+(* Primary structure: strand A CUGCCACGUCUG, strand B CAGACGUGGCAG
+
+ Secondary structure: strand A CUGCCACGUCUG
+ ||||||||||||
+ GACGGUGCAGAC strand B
+
+ Tertiary structure:
+
+ 5' end of strand A C1----G12 3' end of strand B
+ U2-------A11
+ G3-------C10
+ C4-----G9
+ C5---G8
+ A6
+ G6-C7
+ C5----G8
+ A4-------U9
+ G3--------C10
+ A2-------U11
+ 5' end of strand B C1----G12 3' end of strand A
+
+ "helix", "stacked" and "connected" describe the spatial relationship
+ between two consecutive nucleotides. E.g. the nucleotides C1 and U2
+ from the strand A.
+
+ "wc" (stands for Watson-Crick and is a type of base-pairing),
+ and "wc-dumas" describe the spatial relationship between
+ nucleotides from two chains that are growing in opposite directions.
+ E.g. the nucleotides C1 from strand A and G12 from strand B.
+*)
+
+(* Dynamic Domains *)
+
+(* Given,
+ "refnuc" a nucleotide which is already positioned,
+ "nucl" the nucleotide to be placed,
+ and "tfo" a transformation matrix which expresses the desired
+ relationship between "refnuc" and "nucl",
+ the function "dgf-base" computes the transformation matrix that
+ places the nucleotide "nucl" in the given relationship to "refnuc".
+*)
+
+let
+dgf_base tfo v nucl
+ = let x = if is_A v.n then
+ tfo_align (atom_pos nuc_C1' v)
+ (atom_pos rA_N9 v)
+ (atom_pos nuc_C4 v)
+ else if is_C v.n then
+ tfo_align (atom_pos nuc_C1' v)
+ (atom_pos nuc_N1 v)
+ (atom_pos nuc_C2 v)
+ else if is_G v.n then
+ tfo_align (atom_pos nuc_C1' v)
+ (atom_pos rG_N9 v)
+ (atom_pos nuc_C4 v)
+ else
+ tfo_align (atom_pos nuc_C1' v)
+ (atom_pos nuc_N1 v)
+ (atom_pos nuc_C2 v)
+ in
+ tfo_combine (nuc_dgf_base_tfo nucl)
+ (tfo_combine tfo (tfo_inv_ortho x))
+
+(* Placement of first nucleotide. *)
+
+let
+reference n i partial_inst = [ mk_var i tfo_id n ]
+
+(* The transformation matrix for wc is from:
+
+ Chandrasekaran R. et al (1989) A Re-Examination of the Crystal
+ Structure of A-DNA Using Fiber Diffraction Data. J. Biomol.
+ Struct. & Dynamics 6(6):1189-1202.
+*)
+
+let wc_tfo
+ = (
+ { a= -1.0000; b=0.0028; c= -0.0019;
+ d=0.0028; e=0.3468; f= -0.9379;
+ g= -0.0019; h= -0.9379; i= -0.3468;
+ tx= -0.0080; ty=6.0730; tz=8.7208 }
+ )
+
+let
+wc nucl i j partial_inst
+ = [ mk_var i (dgf_base wc_tfo (get_var j partial_inst) nucl) nucl ]
+
+let wc_dumas_tfo
+ = (
+ { a= -0.9737; b= -0.1834; c=0.1352;
+ d= -0.1779; e=0.2417; f= -0.9539;
+ g=0.1422; h= -0.9529; i= -0.2679;
+ tx=0.4837; ty=6.2649; tz=8.0285 }
+ )
+
+let
+wc_dumas nucl i j partial_inst
+ = [ mk_var i (dgf_base wc_dumas_tfo (get_var j partial_inst) nucl) nucl ]
+
+let helix5'_tfo
+ = (
+ { a=0.9886; b= -0.0961; c=0.1156;
+ d=0.1424; e=0.8452; f= -0.5152;
+ g= -0.0482; h=0.5258; i=0.8492;
+ tx= -3.8737; ty=0.5480; tz=3.8024 }
+ )
+
+let
+helix5' nucl i j partial_inst
+ = [ mk_var i (dgf_base helix5'_tfo (get_var j partial_inst) nucl) nucl ]
+
+let helix3'_tfo
+ = (
+ { a=0.9886; b=0.1424; c= -0.0482;
+ d= -0.0961; e=0.8452; f=0.5258;
+ g=0.1156; h= -0.5152; i=0.8492;
+ tx=3.4426; ty=2.0474; tz= -3.7042 }
+ )
+
+let
+helix3' nucl i j partial_inst
+ = [ mk_var i (dgf_base helix3'_tfo (get_var j partial_inst) nucl) nucl ]
+
+let g37_a38_tfo
+ = (
+ { a=0.9991; b=0.0164; c= -0.0387;
+ d= -0.0375; e=0.7616; f= -0.6470;
+ g=0.0189; h=0.6478; i=0.7615;
+ tx= -3.3018; ty=0.9975; tz=2.5585 }
+ )
+
+let
+g37_a38 nucl i j partial_inst
+ = mk_var i (dgf_base g37_a38_tfo (get_var j partial_inst) nucl) nucl
+
+let
+stacked5' nucl i j partial_inst
+ = (g37_a38 nucl i j partial_inst) :: (helix5' nucl i j partial_inst)
+
+let a38_g37_tfo
+ = (
+ { a=0.9991; b= -0.0375; c=0.0189;
+ d=0.0164; e=0.7616; f=0.6478;
+ g= -0.0387; h= -0.6470; i=0.7615;
+ tx=3.3819; ty=0.7718; tz= -2.5321 }
+ )
+
+let
+a38_g37 nucl i j partial_inst
+ = mk_var i (dgf_base a38_g37_tfo (get_var j partial_inst) nucl) nucl
+
+let
+stacked3' nucl i j partial_inst
+ = (a38_g37 nucl i j partial_inst) :: (helix3' nucl i j partial_inst)
+
+let
+p_o3' nucls i j partial_inst
+ = let refnuc = get_var j partial_inst in
+ let align = tfo_inv_ortho
+ (tfo_align (atom_pos nuc_O3' refnuc)
+ (atom_pos nuc_C3' refnuc)
+ (atom_pos nuc_C4' refnuc)) in
+ let rec generate domains = function
+ [] -> domains
+ | n::ns ->
+ generate
+ ((mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n)::
+ (mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n)::
+ (mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n)::domains)
+ ns
+ in
+ generate [] nucls
+
+(* -- PROBLEM STATEMENT -----------------------------------------------------*)
+
+(* Define anticodon problem -- Science 253:1255 Figure 3a, 3b and 3c *)
+
+let
+anticodon_domains
+ = [
+ reference rC 27;
+ helix5' rC 28 27;
+ helix5' rA 29 28;
+ helix5' rG 30 29;
+ helix5' rA 31 30;
+ wc rU 39 31;
+ helix5' rC 40 39;
+ helix5' rU 41 40;
+ helix5' rG 42 41;
+ helix5' rG 43 42;
+ stacked3' rA 38 39;
+ stacked3' rG 37 38;
+ stacked3' rA 36 37;
+ stacked3' rA 35 36;
+ stacked3' rG 34 35; (* <-. Distance *)
+ p_o3' rCs 32 31; (* | Constraint *)
+ p_o3' rUs 33 32 (* <-' 3.0 Angstroms *)
+ ]
+
+(* Anticodon constraint *)
+
+let
+anticodon_constraint v partial_inst =
+ let rec dist j = let p = atom_pos nuc_P (get_var j partial_inst) in
+ let o3' = atom_pos nuc_O3' v in
+ pt_dist p o3'
+ in
+ if v.id = 33 then
+ (dist 34) <= 3.0
+ else
+ true
+
+let
+anticodon () = search [] anticodon_domains anticodon_constraint
+
+(* Define pseudoknot problem -- Science 253:1255 Figure 4a and 4b *)
+
+let
+pseudoknot_domains
+ = [
+ reference rA 23;
+ wc_dumas rU 8 23;
+ helix3' rG 22 23;
+ wc_dumas rC 9 22;
+ helix3' rG 21 22;
+ wc_dumas rC 10 21;
+ helix3' rC 20 21;
+ wc_dumas rG 11 20;
+ helix3' rU' 19 20; (* <-. *)
+ wc_dumas rA 12 19; (* | Distance *)
+(* | Constraint *)
+(* Helix 1 | 4.0 Angstroms *)
+ helix3' rC 3 19; (* | *)
+ wc_dumas rG 13 3; (* | *)
+ helix3' rC 2 3; (* | *)
+ wc_dumas rG 14 2; (* | *)
+ helix3' rC 1 2; (* | *)
+ wc_dumas rG' 15 1; (* | *)
+(* | *)
+(* L2 LOOP | *)
+ p_o3' rUs 16 15; (* | *)
+ p_o3' rCs 17 16; (* | *)
+ p_o3' rAs 18 17; (* <-' *)
+(* *)
+(* L1 LOOP *)
+ helix3' rU 7 8; (* <-. *)
+ p_o3' rCs 4 3; (* | Constraint *)
+ stacked5' rU 5 4; (* | 4.5 Angstroms *)
+ stacked5' rC 6 5 (* <-' *)
+ ]
+
+(* Pseudoknot constraint *)
+
+let
+pseudoknot_constraint v partial_inst =
+ let rec dist j =
+ let p = atom_pos nuc_P (get_var j partial_inst) in
+ let o3' = atom_pos nuc_O3' v in
+ pt_dist p o3'
+ in
+ if v.id = 18 then
+ (dist 19) <= 4.0
+ else if v.id = 6 then
+ (dist 7) <= 4.5
+ else
+ true
+
+let
+pseudoknot () = search [] pseudoknot_domains pseudoknot_constraint
+
+(* -- TESTING ---------------------------------------------------------------*)
+
+let list_of_atoms = function
+ (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,
+ A (n6,n7,n9,c8,h2,h61,h62,h8)))
+ -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+ h3';o3';n1;n3;c2;c4;c5;c6;n6;n7;n9;c8;h2;h61;h62;h8|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,
+ C (n4,o2,h41,h42,h5,h6)))
+ -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+ h3';o3';n1;n3;c2;c4;c5;c6;n4;o2;h41;h42;h5;h6|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,
+ G (n2,n7,n9,c8,o6,h1,h21,h22,h8)))
+ -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+ h3';o3';n1;n3;c2;c4;c5;c6;n2;n7;n9;c8;o6;h1;h21;h22;h8|]
+
+| (N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
+ p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
+ c3',h3',o3',n1,n3,c2,c4,c5,c6,
+ U (o2,o4,h3,h5,h6)))
+ -> [|p;o1p;o2p;o5';c5';h5';h5'';c4';h4';o4';c1';h1';c2';h2'';o2';h2';c3';
+ h3';o3';n1;n3;c2;c4;c5;c6;o2;o4;h3;h5;h6|]
+
+let maximum = function
+ | x::xs ->
+ let rec iter m = function
+ [] -> m
+ | (a::b) -> iter (if a > m then a else m) b
+ in
+ iter x xs
+ | _ -> assert false
+
+let
+var_most_distant_atom v =
+ let atoms = list_of_atoms v.n in
+ let max_dist = ref 0.0 in
+ for i = 0 to pred (Array.length atoms) do
+ let p = atoms.(i) in
+ let distance =
+ let pos = absolute_pos v p
+ in sqrt ((pos.x * pos.x) + (pos.y * pos.y) + (pos.z * pos.z)) in
+ if distance > !max_dist then max_dist := distance
+ done;
+ !max_dist
+
+let
+sol_most_distant_atom s = maximum (List.map var_most_distant_atom s)
+
+let
+most_distant_atom sols = maximum (List.map sol_most_distant_atom sols)
+
+let
+check () = List.length (pseudoknot ())
+
+let
+run () = most_distant_atom (pseudoknot ())
+
+let main () =
+ for i = 1 to 50 do ignore(run()) done;
+ assert (abs_float (run () -. 33.7976) < 0.0002)
+(*
+ Printf.printf "%.4f" (run ()); print_newline()
+*)
+
+let _ = main ()
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/quicksort.ml js-of-ocaml-2.2/benchmarks/sources/ml/quicksort.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/quicksort.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/quicksort.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,92 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: quicksort.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+(* Good test for loops. Best compiled with -unsafe. *)
+
+let rec qsort lo hi (a : int array) =
+ if lo < hi then begin
+ let i = ref lo in
+ let j = ref hi in
+ let pivot = a.(hi) in
+ while !i < !j do
+ while !i < hi && a.(!i) <= pivot do incr i done;
+ while !j > lo && a.(!j) >= pivot do decr j done;
+ if !i < !j then begin
+ let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp
+ end
+ done;
+ let temp = a.(!i) in a.(!i) <- a.(hi); a.(hi) <- temp;
+ qsort lo (!i-1) a;
+ qsort (!i+1) hi a
+ end
+
+
+(* Same but abstract over the comparison to force spilling *)
+
+let cmp i j = i - j
+
+let rec qsort2 lo hi (a : int array) =
+ if lo < hi then begin
+ let i = ref lo in
+ let j = ref hi in
+ let pivot = a.(hi) in
+ while !i < !j do
+ while !i < hi && cmp a.(!i) pivot <= 0 do incr i done;
+ while !j > lo && cmp a.(!j) pivot >= 0 do decr j done;
+ if !i < !j then begin
+ let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp
+ end
+ done;
+ let temp = a.(!i) in a.(!i) <- a.(hi); a.(hi) <- temp;
+ qsort2 lo (!i-1) a;
+ qsort2 (!i+1) hi a
+ end
+
+
+(* Test *)
+
+let seed = ref 0
+
+let random() =
+ seed := !seed * 25173 + 17431; !seed land 0xFFF
+
+
+exception Failed
+
+let test_sort sort_fun size =
+ let a = Array.create size 0 in
+ let check = Array.create 4096 0 in
+ for i = 0 to size-1 do
+ let n = random() in a.(i) <- n; check.(n) <- check.(n)+1
+ done;
+ sort_fun 0 (size-1) a;
+ try
+ check.(a.(0)) <- check.(a.(0)) - 1;
+ for i = 1 to size-1 do
+ if a.(i-1) > a.(i) then raise Failed;
+ check.(a.(i)) <- check.(a.(i)) - 1
+ done;
+ for i = 0 to 4095 do
+ if check.(i) <> 0 then raise Failed
+ done;
+ (*print_string "OK"; print_newline()*)
+ with Failed ->
+ assert false(*print_string "failed"; print_newline()*)
+
+
+let main () =
+ test_sort qsort 500000;
+ test_sort qsort2 500000
+
+let _ = main(); (*exit 0*)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/raytrace.ml js-of-ocaml-2.2/benchmarks/sources/ml/raytrace.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/raytrace.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/raytrace.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,498 @@
+module Color = struct
+
+ type t = { red : float; green : float; blue : float }
+
+ let make r g b = { red = r; green = g; blue = b }
+
+(*
+ let print ch c =
+ let r = truncate (c.red *. 255.) in
+ let g = truncate (c.green *. 255.) in
+ let b = truncate (c.blue *. 255.) in
+ Format.fprintf ch "rgb(%d,%d,%d)" r g b
+*)
+
+ let limit c =
+ { red =
+ (let red = c.red in
+ if red <= 0. then 0. else if red > 1.0 then 1.0 else red);
+ green =
+ (let green = c.green in
+ if green <= 0. then 0. else if green > 1.0 then 1.0 else green);
+ blue =
+ (let blue = c.blue in
+ if blue <= 0. then 0. else if blue > 1.0 then 1.0 else blue) }
+
+ let add c1 c2 =
+ { red = c1.red +. c2.red;
+ green = c1.green +. c2.green;
+ blue = c1.blue +. c2.blue }
+
+ let add_scalar c1 s =
+ limit { red = c1.red +. s; green = c1.green +. s; blue = c1.blue +. s }
+
+ let subtract c1 c2 =
+ { red = c1.red -. c2.red;
+ green = c1.green -. c2.green;
+ blue = c1.blue -. c2.blue }
+
+ let multiply c1 c2 =
+ { red = c1.red *. c2.red;
+ green = c1.green *. c2.green;
+ blue = c1.blue *. c2.blue }
+
+ let multiply_scalar c1 s =
+ { red = c1.red *. s;
+ green = c1.green *. s;
+ blue = c1.blue *. s }
+
+ let divide_factor c1 f =
+ { red = c1.red /. f;
+ green = c1.green /. f;
+ blue = c1.blue /. f }
+
+ let distance c1 c2 =
+ abs_float (c1.red -. c2.red) +.
+ abs_float (c1.green -. c2.green) +.
+ abs_float (c1.blue -. c2.blue)
+
+ let blend c1 c2 w =
+ add (multiply_scalar c1 (1. -. w)) (multiply_scalar c2 w)
+
+ let brightness c =
+ let r = truncate (c.red *. 255.) in
+ let g = truncate (c.green *. 255.) in
+ let b = truncate (c.blue *. 255.) in
+ (r * 77 + g * 150 + b * 29) lsr 8
+
+end
+
+module Vector = struct
+
+ type t = { x : float; mutable y : float; z : float }
+
+ let make x y z = { x = x; y = y; z = z }
+
+(*
+ let print ch v = Format.fprintf ch "%f %f %f" v.x v.y v.z
+*)
+
+ let magnitude v = sqrt (v.x *. v.x +. v.y *. v.y +. v.z *. v.z)
+
+ let normalize v =
+ let m = magnitude v in
+ { x = v.x /. m; y = v.y /. m; z = v.z /. m }
+
+ let cross v w =
+ { x = v.y *. w.z -. v.z *. w.y;
+ y = v.z *. w.x -. v.x *. w.z;
+ z = v.x *. w.y -. v.y *. w.x }
+
+ let dot v w = v.x *. w.x +. v.y *. w.y +. v.z *. w.z
+
+ let add v w =
+ { x = v.x +. w.x; y = v.y +. w.y; z = v.z +. w.z }
+
+ let subtract v w =
+ { x = v.x -. w.x; y = v.y -. w.y; z = v.z -. w.z }
+
+ let multiply_vector v w =
+ { x = v.x *. w.x; y = v.y *. w.y; z = v.z *. w.z }
+
+ let multiply_scalar v w =
+ { x = v.x *. w; y = v.y *. w; z = v.z *. w }
+
+end
+
+module Light = struct
+
+ type t = { position : Vector.t; color : Color.t; intensity : float }
+
+ let make p c i = { position = p; color = c; intensity = i }
+
+end
+
+module Ray = struct
+
+ type t = { position : Vector.t; direction : Vector.t }
+
+ let make p d = { position = p; direction = d }
+
+end
+
+module Intersection_info = struct
+
+ type 'a t =
+ { shape : 'a;
+ distance : float;
+ position : Vector.t;
+ normal : Vector.t;
+ color : Color.t }
+
+end
+
+module Camera = struct
+
+ type t =
+ { position : Vector.t; look_at : Vector.t;
+ equator : Vector.t; up : Vector.t; screen : Vector.t }
+
+ let make pos look_at up =
+ { position = pos; look_at = look_at; up = up;
+ equator = Vector.cross (Vector.normalize look_at) up;
+ screen = Vector.add pos look_at }
+
+ let get_ray c vx vy =
+ let pos =
+ Vector.subtract c.screen
+ (Vector.subtract
+ (Vector.multiply_scalar c.equator vx)
+ (Vector.multiply_scalar c.up vy))
+ in
+ pos.Vector.y <- pos.Vector.y *. -1.;
+ let dir = Vector.subtract pos c.position in
+ Ray.make pos (Vector.normalize dir)
+
+end
+
+module Background = struct
+
+ type t = { color : Color.t; ambience : float }
+
+ let make c a = { color = c; ambience = a }
+
+end
+
+module Material = struct
+
+ type t =
+ { reflection : float;
+ transparency : float;
+ gloss : float;
+ has_texture : bool; get_color : float -> float -> Color.t }
+
+ let wrap_up t =
+ let t = mod_float t 2.0 in
+ if t < -1. then t +. 2.0 else if t >= 1. then t -. 2.0 else t
+
+
+ let solid color reflection transparency gloss =
+ { reflection = reflection; transparency = transparency;
+ gloss = gloss; has_texture = false; get_color = fun _ _ -> color }
+
+ let chessboard color_even color_odd reflection transparency gloss density =
+ { reflection = reflection; transparency = transparency;
+ gloss = gloss; has_texture = true;
+ get_color =
+ fun u v ->
+ let t = wrap_up (u *. density) *. wrap_up (v *. density) in
+ if t < 0. then color_even else color_odd }
+end
+
+module Shape = struct
+
+ type shape =
+ Sphere of Vector.t * float
+ | Plane of Vector.t * float
+
+ type t = { shape : shape; material : Material.t }
+
+ let make shape material = { shape = shape; material = material }
+
+ let dummy =
+ make (Sphere (Vector.make 0. 0. 0., 0.))
+ (Material.solid (Color.make 0. 0. 0.) 0. 0. 0.)
+
+ let position s =
+ match s.shape with Sphere (p, _) -> p | Plane (p, _) -> p
+
+ let intersect s ray =
+ match s.shape with
+ Sphere (position, radius) ->
+ let dst = Vector.subtract ray.Ray.position position in
+ let b = Vector.dot dst ray.Ray.direction in
+ let c = Vector.dot dst dst -. radius *. radius in
+ let d = b *. b -. c in
+ if d > 0. then begin
+ let dist = -. b -. sqrt d in
+ let pos =
+ Vector.add ray.Ray.position
+ (Vector.multiply_scalar ray.Ray.direction dist)
+ in
+ Some { Intersection_info.shape = s;
+ distance = dist;
+ position = pos;
+ normal = Vector.normalize (Vector.subtract pos position);
+ color = s.material.Material.get_color 0. 0. }
+ end else
+ None
+ | Plane (position, d) ->
+ let vd = Vector.dot position ray.Ray.direction in
+ if vd = 0. then None else begin
+ let t = -. (Vector.dot position ray.Ray.position +. d) /. vd in
+ if t <= 0. then None else begin
+ let pos =
+ Vector.add ray.Ray.position
+ (Vector.multiply_scalar ray.Ray.direction t)
+ in
+ Some { Intersection_info.shape = s;
+ distance = t;
+ position = pos;
+ normal = position;
+ color =
+ if s.material.Material.has_texture then begin
+ let vu = Vector.make position.Vector.y
+ position.Vector.z
+ (-. position.Vector.x)
+ in
+ let vv = Vector.cross vu position in
+ let u = Vector.dot pos vu in
+ let v = Vector.dot pos vv in
+ s.material.Material.get_color u v
+ end else
+ s.material.Material.get_color 0. 0. }
+ end
+ end
+end
+
+module Scene = struct
+
+ type t =
+ { camera : Camera.t;
+ shapes : Shape.t array;
+ lights : Light.t array;
+ background : Background.t }
+
+ let make c s l b =
+ { camera = c; shapes = s; lights = l; background = b }
+
+end
+
+module Engine = struct
+
+ type t =
+ { pixel_width : int;
+ pixel_height : int;
+ canvas_width : int;
+ canvas_height : int;
+ render_diffuse : bool;
+ render_shadows : bool;
+ render_highlights : bool;
+ render_reflections : bool;
+ ray_depth : int;
+ }
+
+ let check_number = ref 0
+
+ let get_reflection_ray p n v =
+ let c1 = -. Vector.dot n v in
+ let r1 = Vector.add (Vector.multiply_scalar n (2. *. c1)) v in
+ Ray.make p r1
+
+ let rec ray_trace options info ray scene depth =
+ let old_color =
+ Color.multiply_scalar
+ info.Intersection_info.color scene.Scene.background.Background.ambience
+ in
+ let color = ref old_color in
+ let shininess =
+ 10. **
+ (info.Intersection_info.shape.Shape.material.Material.gloss +. 1.)
+ in
+ let lights = scene.Scene.lights in
+ for i = 0 to Array.length lights - 1 do
+ let light = lights.(i) in
+ let v =
+ Vector.normalize
+ (Vector.subtract
+ light.Light.position info.Intersection_info.position)
+ in
+ if options.render_diffuse then begin
+ let l = Vector.dot v info.Intersection_info.normal in
+ if l > 0. then
+ color :=
+ Color.add !color
+ (Color.multiply info.Intersection_info.color
+ (Color.multiply_scalar light.Light.color l))
+ end;
+ if depth <= options.ray_depth then begin
+ if
+ options.render_reflections &&
+ info.Intersection_info.shape.Shape.material.Material.reflection > 0.
+ then begin
+ let reflection_ray =
+ get_reflection_ray
+ info.Intersection_info.position
+ info.Intersection_info.normal
+ ray.Ray.direction
+ in
+ let col =
+ match
+ test_intersection
+ reflection_ray scene info.Intersection_info.shape
+ with
+ Some ({ Intersection_info.distance = d } as info) when d > 0. ->
+ ray_trace options info reflection_ray scene (depth + 1)
+ | _ ->
+ scene.Scene.background.Background.color
+ in
+ color :=
+ Color.blend !color col
+ info.Intersection_info.shape.Shape.material.Material.reflection
+ end
+ end;
+ let shadow_info = ref None in
+ if options.render_shadows then begin
+ let shadow_ray = Ray.make info.Intersection_info.position v in
+ shadow_info :=
+ test_intersection shadow_ray scene info.Intersection_info.shape;
+ match !shadow_info with
+ Some info ->
+ (*XXX This looks wrong! *)
+ let va = Color.multiply_scalar !color 0.5 in
+ let db =
+ 0.5 *.
+ info.Intersection_info.shape
+ .Shape.material.Material.transparency ** 0.5
+ in
+ color := Color.add_scalar va db
+ | None ->
+ ()
+ end;
+ if
+ options.render_highlights && !shadow_info <> None &&
+ info.Intersection_info.shape.Shape.material.Material.gloss > 0.
+ then begin
+ (*XXX This looks wrong! *)
+ let shape_position = Shape.position info.Intersection_info.shape in
+ let lv =
+ Vector.normalize
+ (Vector.subtract shape_position light.Light.position)
+ in
+ let e =
+ Vector.normalize
+ (Vector.subtract scene.Scene.camera.Camera.position shape_position)
+ in
+ let h = Vector.normalize (Vector.subtract e lv) in
+ let gloss_weight =
+ (max (Vector.dot info.Intersection_info.normal h) 0.) **
+ shininess
+ in
+ color :=
+ Color.add
+ (Color.multiply_scalar light.Light.color gloss_weight) !color
+ end
+ done;
+ Color.limit !color
+
+ and test_intersection ray scene exclude =
+ let best = ref None in
+ let dist = ref 2000. in
+ let shapes = scene.Scene.shapes in
+ for i = 0 to Array.length shapes - 1 do
+ let shape = shapes.(i) in
+ if shape != exclude then begin
+ match Shape.intersect shape ray with
+ Some { Intersection_info.distance = d } as v
+ when d >= 0. && d < !dist ->
+ best := v;
+ dist := d
+ | _ ->
+ ()
+ end
+ done;
+ !best
+
+ let get_pixel_color options ray scene =
+ match test_intersection ray scene Shape.dummy with
+ Some info -> ray_trace options info ray scene 0
+ | None -> scene.Scene.background.Background.color
+
+ let set_pixel options x y color =
+ if x == y then check_number := !check_number + Color.brightness color;
+((*
+ let pxw = options.pixel_width in
+ let pxh = options.pixel_height in
+ Format.eprintf "%d %d %d %d %d %a@." (x * pxw) (y * pxh) pxw pxh !check_number Color.print color;
+*))
+
+ let render_scene options scene canvas =
+ check_number := 0;
+ (*XXX canvas *)
+ let canvas_height = options.canvas_height in
+ let canvas_width = options.canvas_width in
+ for y = 0 to canvas_height - 1 do
+ for x = 0 to canvas_width - 1 do
+ let yp = float y /. float canvas_height *. 2. -. 1. in
+ let xp = float x /. float canvas_width *. 2. -. 1. in
+ let ray = Camera.get_ray scene.Scene.camera xp yp in
+ let color = get_pixel_color options ray scene in
+ set_pixel options x y color
+ done
+ done;
+ assert (!check_number = 2321)
+
+ let make
+ canvas_width canvas_height pixel_width pixel_height
+ render_diffuse render_shadows render_highlights render_reflections
+ ray_depth =
+ { canvas_width = canvas_width / pixel_width;
+ canvas_height = canvas_height / pixel_height;
+ pixel_width = pixel_width; pixel_height = pixel_height;
+ render_diffuse = render_diffuse;
+ render_shadows = render_shadows;
+ render_highlights = render_highlights;
+ render_reflections = render_reflections;
+ ray_depth = ray_depth }
+
+end
+
+let render_scene () =
+ let camera =
+ Camera.make
+ (Vector.make 0. 0. (-15.))
+ (Vector.make (-0.2) 0. 5.)
+ (Vector.make 0. 1. 0.)
+ in
+ let background = Background.make (Color.make 0.5 0.5 0.5) 0.4 in
+ let sphere =
+ Shape.make
+ (Shape.Sphere (Vector.make (-1.5) 1.5 2., 1.5))
+ (Material.solid (Color.make 0. 0.5 0.5) 0.3 0. 2.)
+ in
+ let sphere1 =
+ Shape.make
+ (Shape.Sphere (Vector.make 1. 0.25 1., 0.5))
+ (Material.solid (Color.make 0.9 0.9 0.9) 0.1 0. 1.5)
+ in
+ let plane =
+ Shape.make
+ (Shape.Plane (Vector.normalize (Vector.make 0.1 0.9 (-0.5)), 1.2))
+ (Material.chessboard (Color.make 1. 1. 1.) (Color.make 0. 0. 0.)
+ 0.2 0. 1.0 0.7)
+ in
+ let light =
+ Light.make (Vector.make 5. 10. (-1.)) (Color.make 0.8 0.8 0.8) 10. in
+ let light1 =
+ Light.make (Vector.make (-3.) 5. (-15.)) (Color.make 0.8 0.8 0.8) 100. in
+ let scene =
+ Scene.make camera [|plane; sphere; sphere1|] [|light; light1|] background
+ in
+ let image_width = 100 in
+ let image_height = 100 in
+ let pixel_size = (5, 5) in
+ let render_diffuse = true in
+ let render_shadows = true in
+ let render_highlights = true in
+ let render_reflections = true in
+ let ray_depth = 2 in
+ let engine =
+ Engine.make
+ image_width image_height (fst pixel_size) (snd pixel_size)
+ render_diffuse render_shadows render_highlights render_reflections
+ ray_depth
+ in
+ Engine.render_scene engine scene None
+
+let _ = for i = 0 to 99 do render_scene () done
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/soli.ml js-of-ocaml-2.2/benchmarks/sources/ml/soli.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/soli.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/soli.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,116 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: soli.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+
+type peg = Out | Empty | Peg
+
+let board = [|
+ [| Out; Out; Out; Out; Out; Out; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
+ [| Out; Peg; Peg; Peg; Empty; Peg; Peg; Peg; Out|];
+ [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
+ [| Out; Out; Out; Out; Out; Out; Out; Out; Out|]
+|]
+
+
+(*
+let print_peg = function
+ Out -> print_string "."
+ | Empty -> print_string " "
+ | Peg -> print_string "$"
+
+
+let print_board board =
+ for i=0 to 8 do
+ for j=0 to 8 do
+ print_peg board.(i).(j)
+ done;
+ print_newline()
+ done
+*)
+
+type direction = { dx: int; dy: int }
+
+let dir = [| {dx = 0; dy = 1}; {dx = 1; dy = 0};
+ {dx = 0; dy = -1}; {dx = -1; dy = 0} |]
+
+type move = { x1: int; y1: int; x2: int; y2: int }
+
+let moves = Array.create 31 {x1=0;y1=0;x2=0;y2=0}
+
+let counter = ref 0
+
+exception Found
+
+let rec solve m =
+ counter := !counter + 1;
+ if m = 31 then
+ begin match board.(4).(4) with Peg -> true | _ -> false end
+ else
+ try
+(*
+ if !counter mod 500 = 0 then begin
+ print_int !counter; print_newline()
+ end;
+*)
+ for i=1 to 7 do
+ for j=1 to 7 do
+ match board.(i).(j) with
+ Peg ->
+ for k=0 to 3 do
+ let d1 = dir.(k).dx in
+ let d2 = dir.(k).dy in
+ let i1 = i+d1 in
+ let i2 = i1+d1 in
+ let j1 = j+d2 in
+ let j2 = j1+d2 in
+ match board.(i1).(j1) with
+ Peg ->
+ begin match board.(i2).(j2) with
+ Empty ->
+(*
+ print_int i; print_string ", ";
+ print_int j; print_string ") dir ";
+ print_int k; print_string "\n";
+*)
+ board.(i).(j) <- Empty;
+ board.(i1).(j1) <- Empty;
+ board.(i2).(j2) <- Peg;
+ if solve(m+1) then begin
+ moves.(m) <- { x1=i; y1=j; x2=i2; y2=j2 };
+ raise Found
+ end;
+ board.(i).(j) <- Peg;
+ board.(i1).(j1) <- Peg;
+ board.(i2).(j2) <- Empty
+ | _ -> ()
+ end
+ | _ -> ()
+ done
+ | _ ->
+ ()
+ done
+ done;
+ false
+ with Found ->
+ true
+
+
+let _ = if solve 0 then ((*print_string "\n"; print_board board*)) else assert false
+
+
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/splay.ml js-of-ocaml-2.2/benchmarks/sources/ml/splay.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/splay.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/splay.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,255 @@
+(*
+// Copyright 2009 the V8 project authors. All rights reserved.
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are
+// met:
+//
+// * Redistributions of source code must retain the above copyright
+// notice, this list of conditions and the following disclaimer.
+// * Redistributions in binary form must reproduce the above
+// copyright notice, this list of conditions and the following
+// disclaimer in the documentation and/or other materials provided
+// with the distribution.
+// * Neither the name of Google Inc. nor the names of its
+// contributors may be used to endorse or promote products derived
+// from this software without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+// LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+// DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+// THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+// This benchmark is based on a JavaScript log processing module used
+// by the V8 profiler to generate execution time profiles for runs of
+// JavaScript applications, and it effectively measures how fast the
+// JavaScript engine is at allocating nodes and reclaiming the memory
+// used for old nodes. Because of the way splay trees work, the engine
+// also has to deal with a lot of changes to the large tree object
+// graph.
+*)
+(* Translation in ocaml by VB:
+ This program is probably not the best splay tree implementation in OCaml,
+ because it tries to follow exactly the steps of the Google v8 benchmark.
+*)
+
+let kSplayTreeSize = 8000
+let kSplayTreeModifications = 80
+let kSplayTreePayloadDepth = 5
+
+type content_leaf = { array : int array ; string : string }
+
+type content = CLeaf of content_leaf | CNode of content * content
+
+type tree =
+ | Empty
+ | Node of (tree * float * content * tree)
+
+(**
+ * Perform the splay operation for the given key. Moves the node with
+ * the given key to the top of the tree. If no node has the given
+ * key, the last node on the search path is moved to the top of the
+ * tree. This is the simplified top-down splaying algorithm from:
+ * "Self-adjusting Binary Search Trees" by Sleator and Tarjan
+*)
+let rec splay_ ((left, key, value, right) as a) k =
+ if k = key
+ then a
+ else if k < key
+ then (match left with
+ | Empty -> a (* not found *)
+ | Node (lleft, lk, lv, lright) ->
+ if k = lk
+ then (lleft, lk, lv, Node(lright, key, value, right)) (* zig *)
+ else if k < lk
+ then match lleft with
+ | Empty -> (Empty, lk, lv, Node(lright, key, value, right))
+ (* not found *)
+ | Node n -> (* zig-zig *)
+ let (llleft, llk, llv, llright) = splay_ n k in
+ (llleft, llk, llv,
+ Node (llright, lk, lv, Node(lright, key, value, right)))
+ else match lright with
+ | Empty -> (lleft, lk, lv, Node (Empty, key, value, right))
+ | Node n -> (* zig-zag *)
+ let (lrleft, lrk, lrv, lrright) = splay_ n k in
+ (Node (lleft, lk, lv, lrleft), lrk, lrv,
+ Node (lrright, key, value, right)))
+ else (match right with
+ | Empty -> a
+ | Node (rleft, rk, rv, rright) ->
+ if k = rk
+ then (Node (left, key, value, rleft), rk, rv, rright) (* zag *)
+ else if k > rk
+ then match rright with
+ | Empty -> (Node (left, key, value, rleft), rk, rv, rright)
+ (* not found *)
+ | Node n -> (* zag-zag *)
+ let (rrleft, rrk, rrv, rrright) = splay_ n k in
+ (Node (Node (left, key, value, rleft), rk, rv, rrleft),
+ rrk, rrv, rrright)
+ else match rleft with
+ | Empty -> (Node (left, key, value, rleft), rk, rv, rright)
+ (* not found *)
+ | Node n -> (* zag-zig *)
+ let (rlleft, rlk, rlv, rlright) = splay_ n k in
+ (Node (left, key, value, rlleft), rlk, rlv,
+ Node (rlright, rk, rv, rright)))
+
+let rec splay t key = match t with
+ | Empty -> t
+ | Node n -> Node (splay_ n key)
+
+
+
+
+let insert key value t =
+ (* Splay on the key to move the last node on the search path for
+ the key to the root of the tree.*)
+ let t = splay t key in
+ match t with
+ | Empty -> Node (Empty, key, value, Empty)
+ | Node (left, rk, rv, right) ->
+ if rk = key
+ then t
+ else
+ if key > rk
+ then Node (Node (left, rk, rv, Empty), key, value, right)
+ else Node (left, key, value, Node (Empty, rk, rv, right))
+
+
+let remove key t =
+ let t = splay t key in
+ match t with
+ | Empty -> t
+ | Node (_, rk, _, _) when rk <> key -> raise Not_found
+ | Node (Empty, _, _, right) -> right
+ | Node (left, _, _, right) ->
+ match splay left key with
+ | Node (lleft, lk, lv, Empty) -> Node (lleft, lk, lv, right)
+ | _ -> failwith "remove"
+
+let find key t =
+ let t = splay t key in
+ match t with
+ | Node (_, k, v, _) when k = key -> (Some v, t)
+ | _ -> (None, t)
+
+let rec findMax = function
+ (* here we do not splay (but that's what the original program does) *)
+ | Empty -> raise Not_found
+ | Node (_, k, v, Empty) -> k
+ | Node (_, _, _, right) -> findMax right
+
+let findGreatestLessThan key t =
+ (* Splay on the key to move the node with the given key or the last
+ node on the search path to the top of the tree.
+ Now the result is either the root node or the greatest node in
+ the left subtree. *)
+ let t = splay t key in
+ match t with
+ | Empty -> (None, t)
+ | Node (left, k, v, right) when k < key -> (Some k, t)
+ | Node (Empty, k, v, right) -> (None, t)
+ | Node (left, _, _, _) -> (Some (findMax left), t)
+
+let exportKeys t =
+ let rec aux l length = function
+ | Empty -> (l, length)
+ | Node (left, k, _, right) ->
+ let l, length = aux l length right in
+ aux (k::l) (length+1) left
+ in
+ aux [] 0 t
+
+
+let rec generatePayloadTree depth tag =
+ if depth = 0
+ then CLeaf {
+ array = [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 |];
+ string = "String for key " ^ tag ^ " in leaf node"
+ }
+ else
+ CNode(generatePayloadTree (depth - 1) tag,
+ generatePayloadTree (depth - 1) tag)
+
+
+let random =
+ let seed = ref 49734321 in
+ fun () ->
+(* // Robert Jenkins' 32 bit integer hash function. *)
+ let s = !seed in
+ let s = ((s + 0x7ed55d16) + (s lsl 12)) land 0xffffffff in
+ let s = ((s lxor 0xc761c23c) lxor (s lsr 19)) in
+ let s = ((s + 0x165667b1) + (s lsl 5)) in
+ let s = ((s + 0xd3a2646c) lxor (s lsl 9)) in
+ let s = ((s + 0xfd7046c5) + (s lsl 3)) land 0xffffffff in
+ let s = ((s lxor 0xb55a4f09) lxor (s lsr 16)) in
+ seed := s;
+ float (s land 0xfffffff) /. float 0x10000000
+
+let generateKey = random
+
+let insertNewNode t =
+ let rec aux t =
+ let key = generateKey () in
+ let vo, t = find key t in
+ match vo with
+ | None -> key, t
+ | _ -> aux t
+ in
+ let key, t = aux t in
+ let payload = generatePayloadTree kSplayTreePayloadDepth (string_of_float key)
+ in
+ (key, insert key payload t)
+
+let splaySetup () =
+ let rec aux i t =
+ if i < kSplayTreeSize
+ then aux (i+1) (snd (insertNewNode t))
+ else t
+ in
+ aux 0 Empty
+
+let splayTearDown t =
+ let keys, length = exportKeys t in
+
+(* // Verify that the splay tree has the right size. *)
+ if length <> kSplayTreeSize
+ then failwith "Splay tree has wrong size";
+
+(* // Verify that the splay tree has sorted, unique keys. *)
+ match keys with
+ | [] -> ()
+ | a::l ->
+ ignore
+ (List.fold_left
+ (fun b e ->
+ if b >= e then failwith "Splay tree not sorted" else e) a l)
+
+let splayRun t =
+ (* // Replace a few nodes in the splay tree. *)
+ let rec aux i t =
+ if i < kSplayTreeModifications
+ then
+ let key, t = insertNewNode t in
+ aux (i+1)
+ (match findGreatestLessThan key t with
+ | (None, t) -> remove key t
+ | (Some k, t) -> remove k t)
+ else t
+ in
+ aux 0 t
+
+let ( ++ ) a b = b a
+
+let () =
+ splaySetup () ++
+ splayRun ++
+ splayTearDown
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/takc.ml js-of-ocaml-2.2/benchmarks/sources/ml/takc.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/takc.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/takc.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,26 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: takc.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+let rec tak x y z =
+ if x > y then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)
+ else z
+
+let rec repeat n accu =
+ if n <= 0 then accu else repeat (n - 1) (tak 18 12 6 + accu)
+
+let _ =
+assert (repeat 2000 0 = 14000)
+(*
+ print_int (repeat 2000); print_newline(); exit 0
+*)
diff -Nru js-of-ocaml-1.4/benchmarks/sources/ml/taku.ml js-of-ocaml-2.2/benchmarks/sources/ml/taku.ml
--- js-of-ocaml-1.4/benchmarks/sources/ml/taku.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/benchmarks/sources/ml/taku.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,22 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: taku.ml 7017 2005-08-12 09:22:04Z xleroy $ *)
+
+let rec tak (x, y, z) =
+ if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
+ else z
+
+let rec repeat n accu =
+ if n <= 0 then accu else repeat (n - 1) (tak(18,12,6) + accu)
+
+let _ = assert (repeat 2000 0 = 14000)
diff -Nru js-of-ocaml-1.4/CHANGES js-of-ocaml-2.2/CHANGES
--- js-of-ocaml-1.4/CHANGES 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/CHANGES 2014-05-15 08:37:39.000000000 +0000
@@ -1,3 +1,90 @@
+===== 2.2 (2014-05-15) =====
+
+ * Features/Changes
+ ** Runtime: improve blit_string perf
+ ** Compiler: option to warn about unused js variable
+ ** Lib: audio/videoElement
+
+ * BugFixes
+ ** Syntax: catch exception in syntax extension (#158)
+ ** Compiler: compat with Node.js (global object) (#160)
+ ** Runtime: fix graphics.js
+ ** Lib: fix Dom.event interface
+
+===== 2.1 (2014-04-28) =====
+
+ * Features/Changes
+ ** Runtime: bigarray comparison
+ ** Compiler: allow to embed directory with -file dir_name=ext1,ext2:dest_path
+ ** Compiler: can now output embeded files in a differant js file
+ ** Lib: js_of_ocaml.graphics
+ ** Lib: Js.Unsafe.expr to embed JavasScript expression
+ to be used instead of Js.Unsafe.variable (or eval_string)
+ ** Lib: Sys_js.js_of_ocaml_version && Sys_js.file_content
+ ** OCamlbuild plugin: Add the OASIS support, document the API and add the tags
+ sourcemap (included in the meta-tag debug) and tailcall (#148)
+ (by Jacques-Pascal Deplaix)
+
+ * BugFixes
+ ** Syntax: Better type constraint (#84)
+ ** Compiler: caml_failwith primitive was sometime missing (#147)
+ ** Compiler: variable names used outside a program were
+ not marked as reserved (#146)
+ ** Lib: fix WebGl interface
+
+===== 2.0 (2014-04-11) =====
+
+ * Features/Changes
+ ** Compiler: generate shorter variable names
+ ** Parsing and minifying of external javascript file (ie: runtime)
+ (by Hugo Heuzard)
+ ** Compiler: JavaScript strict mode enabled
+ ** Runtime: add support for recursive module (by Hugo Heuzard)
+ ** Compiler: use trampoline to implement tailcall optim (by Hugo Heuzard)
+ ** Improved OCaml toplevel UI (by Hugo Heuzard)
+ ** Toplevel: support dynamic loading of cmo and cma files
+ ** Runtime: add Bigarray support (contributed by Andrew Ray)
+ ** Library: switch from "float Js.t" to just "float" for typing
+ JavaScript numbers
+ ** Compiler: Add javascript file lookup using findlib
+ (+mypkg/myfile.js will read myfile.js from mypkg findlib directory)
+ (by Hugo Heuzard)
+ ** Compiler: improve missing primitives & reserved name detection
+ (by Hugo Heuzard)
+ ** Compiler: static evaluation of constant ("staticeval" optimisation)
+ (by Hugo Heuzard)
+ ** Compiler: share constants (by Hugo Heuzard)
+ ** Compiler: alias primitives (by Hugo Heuzard)
+ ** Compiler: complete javacript ast (by Hugo Heuzard)
+ ** Compiler: 'caml_format_int %d x' compiles to ""+x (by Hugo Heuzard)
+ ** Add JavaScript file in META (to be used with ocamlfind)
+ (by Hugo Heuzard)
+ ** Add Ocamlbuild plugin js_of_ocaml.ocamlbuild
+ (by Jacques-Pascal Deplaix)
+ ** Add/Install classlist.js, weak.js
+ ** Add Url.Current.protocol (by Vicent Balat)
+ ** Dependency: deriving instead of deriving-ocsigen
+ ** Runtime: log wrong string encoding issues to the console (by Hugo Heuzard)
+ ** Add compiler_libs (by Pierre Chambart)
+ ** Compile syntax extension to native code as well (by Hugo Heuzard)
+ ** Add a JavaScript parser (extracted from facebook/pfff)
+ ** Compiler: remove redundant 'var' (by Hugo Heuzard)
+ ** Compiler: improve compact mode, remove unnecessary space, semicolon
+ ** Runtime: Support in_channel and out_channel (by Hugo Heuzard)
+ ** Compiler: option to embed files into the generated js
+ such files can be read using open_in (by Hugo Heuzard)
+ ** Runtime: add cache for method lookup (by Hugo Heuzard)
+ ** Compiler: experimental sourcemap support (by Hugo Heuzard)
+ ** JavaScript Errors are now wrapped inside OCaml exceptions (by Hugo Heuzard)
+
+ * BugFixes
+ ** Compiler: js file is not create in case of error (by Hugo Heuzard)
+ ** Fix compatibility when using type covn (by Hugo Heuzard)
+ ** Fix md5 : incorrect for string where (length % 64) E 56..59 (by Grégoire Henry)
+ ** Fix caml_js_new: when called with more than 8 arguments
+ ** Address a number of integer overflow issues (by Hugo Heuzard)
+ ** Fix float comparisons (NaN was not compared correctly)
+
===== 1.4 (2013-12-03) =====
* Features/Changes
@@ -66,7 +153,7 @@
** Lots of new dom bindings
** WebGL
** Typed arrays
- ** Many speed improvement (marshall, strings, regexps)
+ ** Many speed improvement (marshal, strings, regexps)
** Many bug fixed
* Compiler:
@@ -92,7 +179,7 @@
===== 1.0.7 (2011-11-18) =====
* Bugfixes:
- ** Deriving_json: fix string (un)marshalling (was broken for byte > 127)
+ ** Deriving_json: fix string (un)marshaling (was broken for byte > 127)
** Do not emit string escape sequence \\v (not supported by IE8)
** Removed incorrect optimization of !(x < y) into (x >= y)
** Allow compilation on win32/msvc
@@ -126,7 +213,7 @@
* Bugfixes:
** fix typo in 'greater than or equal to'
- ** marshalling, unmarshalling and comparison
+ ** marshaling, unmarshaling and comparison
are not recursive anymore: avoid stack overflow
** use custom formatter to pretty print Javascript
code to avoid newlines where it is forbidden.
diff -Nru js-of-ocaml-1.4/compiler/annot_lexer.mli js-of-ocaml-2.2/compiler/annot_lexer.mli
--- js-of-ocaml-1.4/compiler/annot_lexer.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/annot_lexer.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val initial : Lexing.lexbuf -> Annot_parser.token
diff -Nru js-of-ocaml-1.4/compiler/annot_lexer.mll js-of-ocaml-2.2/compiler/annot_lexer.mll
--- js-of-ocaml-1.4/compiler/annot_lexer.mll 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/annot_lexer.mll 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,52 @@
+{
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+open Annot_parser
+}
+
+let identifier = ['a'-'z''A'-'Z''_']+
+
+rule initial = parse
+ | "Provides" {TProvides}
+ | "Requires" {TRequires}
+ | "pure" {TA_Pure }
+ | "const" {TA_Const }
+ | "mutable" {TA_Mutable }
+ | "mutator" {TA_Mutator }
+ | "shallow" {TA_Shallow}
+ | "Version" {TVersion}
+ | ['a'-'z''A'-'Z''$''_']['a'-'z''A'-'Z''$''_''0'-'9']* {
+ let x = Lexing.lexeme lexbuf in
+ TIdent x}
+ | ['0'-'9']+ ('.' (['0'-'9']+)) * {
+ let x = Lexing.lexeme lexbuf in
+ TVNum x}
+ | "(" {LPARENT}
+ | ")" {RPARENT}
+ | "," {TComma}
+ | ":" {TSemi}
+ | "<=" {LE}
+ | "<" {LT}
+ | ">" {GT}
+ | ">=" {GE}
+ | "=" {EQ}
+ | [' ''\t']+ { initial lexbuf }
+ | eof { EOF }
+ | ['\n'] {EOL}
+ | _ { TOTHER(Lexing.lexeme lexbuf) }
diff -Nru js-of-ocaml-1.4/compiler/annot_parser.mly js-of-ocaml-2.2/compiler/annot_parser.mly
--- js-of-ocaml-1.4/compiler/annot_parser.mly 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/annot_parser.mly 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,67 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+
+
+%token TProvides TRequires TVersion
+%token TA_Pure TA_Const TA_Mutable TA_Mutator TA_Shallow
+%token TIdent TVNum
+%token TComma TSemi EOF EOL LE LT GE GT EQ LPARENT RPARENT
+%token TOTHER
+
+%start annot
+%type annot
+
+%%
+
+annot:
+ | TProvides TSemi id=TIdent opt=option(prim_annot)
+ args=option(delimited(LPARENT, separated_list(TComma,arg_annot),RPARENT))
+ endline
+ { `Provides (None,id,(match opt with None -> `Mutator | Some k -> k),args) }
+ | TRequires TSemi l=separated_nonempty_list(TComma,TIdent) endline
+ { `Requires (None,l) }
+ | TVersion TSemi l=separated_nonempty_list(TComma,version) endline
+ { `Version (None,l) }
+
+prim_annot:
+ | TA_Pure {`Pure}
+ | TA_Const {`Pure}
+ | TA_Mutable {`Mutable}
+ | TA_Mutator {`Mutator}
+
+arg_annot:
+ | TA_Const { `Const }
+ | TA_Shallow { `Shallow_const}
+ | TA_Mutable { `Mutable}
+
+op:
+ | LE {(<=)}
+ | LT {(<)}
+ | GT {(>)}
+ | GE {(>=)}
+ | EQ {(=)}
+
+version:
+ | op TVNum { $1,$2 }
+
+endline:
+ | EOL { () }
+ | EOF { () }
+ | TOTHER { failwith $1 }
diff -Nru js-of-ocaml-1.4/compiler/code.ml js-of-ocaml-2.2/compiler/code.ml
--- js-of-ocaml-1.4/compiler/code.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/code.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,102 +18,30 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-(*FIX: this should probably be somewhere else... *)
-module VarPrinter = struct
- let names = Hashtbl.create 107
- let name v nm = Hashtbl.add names v nm
- let propagate_name v v' =
- try name v' (Hashtbl.find names v) with Not_found -> ()
- let name v nm =
- let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') in
- let is_num c = (c >= '0' && c <= '9') in
- if String.length nm > 0 then begin
- let nm = String.copy nm in
- if not (is_alpha nm.[0]) then nm.[0] <- '_';
- for i = 1 to String.length nm - 1 do
- if not (is_alpha nm.[i] || is_num nm.[i]) then nm.[i] <- '_';
- done;
- let c = ref 0 in
- for i = 0 to String.length nm - 1 do
- if nm.[i] = '_' then incr c
- done;
- if !c < String.length nm then name v nm
- end
-
- let reserved = Hashtbl.create 107
-
- let add_reserved s =
- if String.length s <= 5 then Hashtbl.replace reserved s ()
-
- let _ =
- List.iter add_reserved
- ["break"; "case"; "catch"; "do"; "else"; "for"; "if"; "in"; "new";
- "this"; "throw"; "try"; "var"; "void"; "while"; "with"; "class";
- "enum"; "super"; "const"; "yield"; "let"]
-
- let known = Hashtbl.create 1001
-
- let last = ref (-1)
-
- let c1 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_$"
- let c2 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$"
-
- let rec format_ident x =
- assert (x >= 0);
- let char c x = String.make 1 (c.[x]) in
- if x < 54 then
- char c1 x
- else
- format_ident ((x - 54) / 64) ^ char c2 ((x - 54) mod 64)
-
- let pretty = ref false
-
- let format_var i x =
- let s = format_ident x in
- if !pretty then begin
- try
- let nm = Hashtbl.find names i in
- Format.sprintf "%s_%s_" nm s
- with Not_found ->
- Format.sprintf "_%s_" s
- end else
- s
-
- let rec to_string i =
- try
- Hashtbl.find known i
- with Not_found ->
- incr last;
- let j = !last in
- let s = format_var i j in
- if Hashtbl.mem reserved s then
- to_string i
- else begin
- Hashtbl.add known i s;
- s
- end
-
- let reset () =
- Hashtbl.clear names; Hashtbl.clear known; last := -1
+type addr = int
- let _ = reset ()
+module DebugAddr : sig
+ type dbg = private addr
+ val of_addr : addr -> dbg
+ val to_addr : dbg -> addr
+ val no : dbg
+end = struct
+ type dbg = int
+ let of_addr (x : addr) = (x : dbg)
+ let no = 0
+ let to_addr (x : dbg) = (x : addr)
end
-let string_of_ident = VarPrinter.format_ident
-
-let add_reserved_name = VarPrinter.add_reserved
-
module Var : sig
type t
+
val print : Format.formatter -> t -> unit
val idx : t -> int
- val to_string : t -> string
-
- type stream
- val make_stream : unit -> stream
- val next : stream -> t * stream
+ val of_idx : int -> t
+ val to_string : ?origin:t -> t -> string
val fresh : unit -> t
+ val fork : t -> t
val count : unit -> int
@@ -121,56 +49,49 @@
val name : t -> string -> unit
val propagate_name : t -> t -> unit
- val set_pretty : unit -> unit
val reset : unit -> unit
+ val set_pretty : bool -> unit
val dummy : t
end = struct
- type t = int * int
-
- let last_var = ref 0
+ open Util
+ type t = int
- let reset () = last_var := 0; VarPrinter.reset ()
+ let printer = VarPrinter.create ()
- type stream = int
-
- let c = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$"
+ let last_var = ref 0
- let rec format_var x =
- let char x = String.make 1 (c.[x]) in
- if x < 65 then
- char (x - 1)
- else
- format_var (x / 64) ^ char (x mod 64)
+ let reset () =
+ last_var := 0;
+ VarPrinter.reset printer
-(*
- let to_string (x, i) = "o$" ^ format_var i(*format_var x ^ Format.sprintf "%d" i*)
-*)
- let to_string (x, i) = VarPrinter.to_string i
+ let to_string ?origin i = VarPrinter.to_string printer ?origin i
- let print f x = Format.fprintf f "%s" (to_string x)
+ let print f x = Format.fprintf f "v%d" x
+ (* Format.fprintf f "%s" (to_string x) *)
- let make_stream () = 1
+ let fresh () = incr last_var; !last_var
- let next current =
- incr last_var;
- ((current, !last_var), current + 1)
+ let count () = !last_var + 1
- let fresh () = incr last_var; (0, !last_var)
+ let idx v = v
- let count () = !last_var + 1
+ let of_idx v = v
- let idx v = snd v
+ let compare v1 v2 = v1 - v2
- let compare (_,v1) (_,v2) = v1 - v2
+ let name i nm = VarPrinter.name printer i nm
+ let propagate_name i j = VarPrinter.propagate_name printer i j
+ let set_pretty b = VarPrinter.set_pretty printer b
- let name (_, i) nm = VarPrinter.name i nm
- let propagate_name (_, i) (_, j) = VarPrinter.propagate_name i j
- let set_pretty () = VarPrinter.pretty := true
+ let fork o =
+ let n = fresh () in
+ propagate_name o n;
+ n
- let dummy = (-1 , -1)
+ let dummy = -1
end
module VarSet = Set.Make (Var)
@@ -198,7 +119,6 @@
let empty v = Array.make (Var.count ()) Var.dummy
end
-type addr = int
module AddrSet = Util.IntSet
module AddrMap = Util.IntMap
@@ -211,25 +131,23 @@
| Extern of string
| Not | IsInt
| Eq | Neq | Lt | Le | Ult
- | WrapInt
type constant =
String of string
+ | IString of string
| Float of float
| Float_array of float array
- | Int32 of int32
- | Nativeint of nativeint
| Int64 of int64
| Tuple of int * constant array
- | Int of int
+ | Int of int32
type prim_arg =
Pv of Var.t
| Pc of constant
type expr =
- Const of int
- | Apply of Var.t * Var.t list * int option
+ Const of int32
+ | Apply of Var.t * Var.t list * bool
| Block of int * Var.t array
| Field of Var.t * int
| Closure of Var.t list * cont
@@ -242,7 +160,7 @@
| Offset_ref of Var.t * int
| Array_set of Var.t * Var.t * Var.t
-type cond = IsTrue | CEq of int | CLt of int | CLe of int | CUlt of int
+type cond = IsTrue | CEq of int32 | CLt of int32 | CLe of int32 | CUlt of int32
type last =
Return of Var.t
@@ -279,6 +197,8 @@
match x with
String s ->
Format.fprintf f "%S" s
+ | IString s ->
+ Format.fprintf f "%S" s
| Float fl ->
Format.fprintf f "%.12g" fl
| Float_array a ->
@@ -288,10 +208,6 @@
Format.fprintf f "%.12g" a.(i)
done;
Format.fprintf f "|]"
- | Int32 i ->
- Format.fprintf f "%ldl" i
- | Nativeint i ->
- Format.fprintf f "%ndn" i
| Int64 i ->
Format.fprintf f "%LdL" i
| Tuple (tag, a) ->
@@ -307,8 +223,7 @@
done;
Format.fprintf f ")"
end
- | Int i ->
- Format.fprintf f "%d" i
+ | Int i -> Format.fprintf f "%ld" i
let print_arg f a =
match a with
@@ -361,15 +276,14 @@
| Lt, [x; y] -> Format.fprintf f "%a < %a" print_arg x print_arg y
| Le, [x; y] -> Format.fprintf f "%a <= %a" print_arg x print_arg y
| Ult, [x; y] -> Format.fprintf f "%a <= %a" print_arg x print_arg y
- | WrapInt, [x] -> Format.fprintf f "to_int(%a)" print_arg x
| _ -> assert false
let print_expr f e =
match e with
Const i ->
- Format.fprintf f "%d" i
- | Apply (g, l, n) ->
- if n = Some (List.length l) then
+ Format.fprintf f "%ld" i
+ | Apply (g, l, exact) ->
+ if exact then
Format.fprintf f "%a!(%a)" Var.print g print_var_list l
else
Format.fprintf f "%a(%a)" Var.print g print_var_list l
@@ -402,10 +316,10 @@
let print_cond f (c, x) =
match c with
IsTrue -> Var.print f x
- | CEq n -> Format.fprintf f "%d = %a" n Var.print x
- | CLt n -> Format.fprintf f "%d < %a" n Var.print x
- | CLe n -> Format.fprintf f "%d <= %a" n Var.print x
- | CUlt n -> Format.fprintf f "%d < %a" n Var.print x
+ | CEq n -> Format.fprintf f "%ld = %a" n Var.print x
+ | CLt n -> Format.fprintf f "%ld < %a" n Var.print x
+ | CLe n -> Format.fprintf f "%ld <= %a" n Var.print x
+ | CUlt n -> Format.fprintf f "%ld < %a" n Var.print x
let print_last f l =
match l with
@@ -471,6 +385,20 @@
(****)
+let prepend (start, blocks, free_pc) body =
+ let new_start = free_pc in
+ let blocks =
+ AddrMap.add new_start
+ { params = [];
+ handler = None;
+ body = body;
+ branch = Branch (start, []) }
+ blocks
+ in
+ let free_pc = free_pc + 1 in
+ (new_start, blocks, free_pc)
+
+
let (>>) x f = f x
let fold_children blocks pc f accu =
@@ -491,7 +419,7 @@
accu >> Array.fold_right (fun (pc, _) accu -> f pc accu) a1
>> Array.fold_right (fun (pc, _) accu -> f pc accu) a2
-let eq (pc1,blocks1,_) (pc2,blocks2,_) =
+let eq (pc1, blocks1, _) (pc2, blocks2, _) =
pc1 = pc2 &&
AddrMap.cardinal blocks1 = AddrMap.cardinal blocks2 &&
AddrMap.fold (fun pc block1 b ->
@@ -501,5 +429,5 @@
block1.params = block2.params &&
block1.branch = block2.branch &&
block1.body = block2.body
- with _ -> false
+ with Not_found -> false
) blocks1 true
diff -Nru js-of-ocaml-1.4/compiler/code.mli js-of-ocaml-2.2/compiler/code.mli
--- js-of-ocaml-1.4/compiler/code.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/code.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,17 +18,25 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
+type addr = int
+
+module DebugAddr : sig
+ type dbg = private int
+ val of_addr : addr -> dbg
+ val to_addr : dbg -> addr
+ val no : dbg
+end
+
module Var : sig
type t
val print : Format.formatter -> t -> unit
val idx : t -> int
- val to_string : t -> string
+ val of_idx : int -> t
- type stream
- val make_stream : unit -> stream
- val next : stream -> t * stream
+ val to_string : ?origin:t -> t -> string
val fresh : unit -> t
+ val fork : t -> t
val count : unit -> int
@@ -36,12 +44,10 @@
val name : t -> string -> unit
val propagate_name : t -> t -> unit
- val set_pretty : unit -> unit
-
val reset : unit -> unit
+ val set_pretty : bool -> unit
end
-val string_of_ident : int -> string
module VarSet : Set.S with type elt = Var.t
module VarMap : Map.S with type key = Var.t
@@ -65,10 +71,10 @@
val copy : t -> t
end
-type addr = int
-module AddrSet : Set.S with type elt = int and type t = Util.IntSet.t
-module AddrMap : Map.S with type key = int and type 'a t = 'a Util.IntMap.t
+
+module AddrSet : Set.S with type elt = addr and type t = Util.IntSet.t
+module AddrMap : Map.S with type key = addr and type 'a t = 'a Util.IntMap.t
type cont = addr * Var.t list
@@ -78,25 +84,24 @@
| Extern of string
| Not | IsInt
| Eq | Neq | Lt | Le | Ult
- | WrapInt
type constant =
String of string
+ | IString of string
| Float of float
| Float_array of float array
- | Int32 of int32
- | Nativeint of nativeint
| Int64 of int64
| Tuple of int * constant array
- | Int of int
+ | Int of int32
type prim_arg =
Pv of Var.t
| Pc of constant
type expr =
- Const of int
- | Apply of Var.t * Var.t list * int option
+ Const of int32
+ | Apply of Var.t * Var.t list * bool
+ (* if true, then # of arguments = # of parameters *)
| Block of int * Var.t array
| Field of Var.t * int
| Closure of Var.t list * cont
@@ -110,7 +115,7 @@
| Array_set of Var.t * Var.t * Var.t
(*XXX REMOVE *)
-type cond = IsTrue | CEq of int | CLt of int | CLe of int | CUlt of int
+type cond = IsTrue | CEq of int32 | CLt of int32 | CLe of int32 | CUlt of int32
type last =
Return of Var.t
@@ -142,7 +147,6 @@
val fold_children :
block AddrMap.t -> addr -> (addr -> 'c -> 'c) -> 'c -> 'c
-val add_reserved_name : string -> unit
-
+val prepend : program -> instr list -> program
val eq : program -> program -> bool
diff -Nru js-of-ocaml-1.4/compiler/compile.ml js-of-ocaml-2.2/compiler/compile.ml
--- js-of-ocaml-1.4/compiler/compile.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/compile.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,211 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let times = Option.Debug.find "times"
+
+let _ = Sys.catch_break true
+
+let gen_file file f =
+ let f_tmp = Filename.temp_file
+ ~temp_dir:(Filename.dirname file)
+ (Filename.basename file) ".tmp" in
+ try
+ let ch = open_out_bin f_tmp in
+ (try f ch with e -> close_out ch; raise e);
+ close_out ch;
+ (try Sys.remove file with Sys_error _ -> ());
+ Sys.rename f_tmp file;
+ with exc ->
+ Sys.remove f_tmp;
+ raise exc
+
+let f toplevel linkall paths files js_files input_file output_file output_file_fs source_map =
+ let t = Util.Timer.make () in
+ Linker.load_files js_files;
+ let paths = List.rev_append paths [Util.find_pkg_dir "stdlib"] in
+ let t1 = Util.Timer.make () in
+ if times () then Format.eprintf "Start parsing...@.";
+ let need_debug =
+ if source_map <> None || Option.Optim.debuginfo () then `Full else
+ if Option.Optim.pretty () then `Names else `No
+ in
+ let p, cmis, d =
+ match input_file with
+ None ->
+ Parse_bytecode.from_channel ~toplevel ~debug:need_debug stdin
+ | Some f ->
+ let ch = open_in_bin f in
+ let p,cmis,d = Parse_bytecode.from_channel ~toplevel ~debug:need_debug ch in
+ close_in ch;
+ p, cmis, d
+ in
+ if times () then Format.eprintf " parsing: %a@." Util.Timer.print t1;
+ begin match output_file with
+ | None ->
+ let p = PseudoFs.f p cmis files paths in
+ let fmt = Pretty_print.to_out_channel stdout in
+ Driver.f ~toplevel ~linkall ?source_map fmt d p
+ | Some file ->
+ gen_file file (fun chan ->
+ let p =
+ if output_file_fs = None
+ then PseudoFs.f p cmis files paths
+ else
+ let instrs = [
+ Code.(Let(Var.fresh (), Prim (Extern "caml_fs_init", [])))
+ ] in
+ Code.prepend p instrs in
+ let fmt = Pretty_print.to_out_channel chan in
+ Driver.f ~toplevel ~linkall ?source_map fmt d p;
+ );
+ Util.opt_iter (fun file ->
+ gen_file file (fun chan ->
+ let pfs = PseudoFs.f_empty cmis files paths in
+ let pfs_fmt = Pretty_print.to_out_channel chan in
+ Driver.f pfs_fmt d pfs
+ )
+ ) output_file_fs
+ end;
+ if times () then Format.eprintf "compilation: %a@." Util.Timer.print t
+
+let run () =
+ Util.Timer.init Sys.time;
+ let js_files = ref [] in
+ let files = ref [] in
+ let output_file = ref None in
+ let output_file_fs = ref None in
+ let input_file = ref None in
+ let no_runtime = ref false in
+ let linkall = ref false in
+ let toplevel = ref false in
+ let source_map = ref false in
+ let show_version = ref `No in
+ let paths = ref [] in
+ let options =
+ [
+ ("-version",Arg.Unit (fun () -> show_version:=`Full) ," display version");
+ ("-vnum",Arg.Unit (fun () -> show_version:=`Number) ," display version number");
+ ("-debug", Arg.String Option.Debug.enable, " debug module ");
+ ("-disable",
+ Arg.String Option.Optim.disable, " disable optimization ");
+ ("-enable",
+ Arg.String Option.Optim.enable, " enable optimization ");
+ ("-pretty", Arg.Unit (fun () -> Option.Optim.enable "pretty"), " pretty print the output");
+ ("-debuginfo", Arg.Unit (fun () -> Option.Optim.enable "debuginfo"), " output debug info");
+ ("-opt", Arg.Int Driver.set_profile, " set optimization profile : o1 (default), o2, o3");
+ ("-noinline", Arg.Unit (fun () -> Option.Optim.disable "inline"), " disable inlining");
+ ("-linkall", Arg.Set linkall, " link all primitives");
+ ("-noruntime", Arg.Unit (fun () -> no_runtime := true),
+ " do not include the standard runtime");
+ ("-sourcemap", Arg.Unit (fun () -> source_map := true), " generate source map");
+ ("-toplevel", Arg.Set toplevel, " compile a toplevel");
+ ("-tc", Arg.Symbol (List.map Option.Tailcall.to_string Option.Tailcall.all,(fun s -> Option.Tailcall.(set (of_string s)))),
+ " set tailcall optimisation");
+ ("-I", Arg.String (fun s -> paths := s :: !paths),
+ " Add to the list of include directories");
+ ("-file", Arg.String (fun s -> files:= s :: !files ),
+ " register to the pseudo filesystem");
+ ("-o", Arg.String (fun s -> output_file := Some s),
+ " set output file name to ");
+ ("-ofs", Arg.String (fun s -> output_file_fs := Some s),
+ " set filesystem ouput file name to ");
+ ]
+ in
+ Arg.parse (Arg.align options)
+ (fun s ->
+ (* internal option for debugging only *)
+ if s="@nofail" then Util.fail:=false
+ else
+ if Filename.check_suffix s ".js" then
+ js_files := s :: !js_files
+ else
+ input_file := Some s)
+ (Format.sprintf "Usage: %s [options]" Sys.argv.(0));
+ let version = match Compiler_version.git_version with
+ | "" -> Compiler_version.s
+ | v -> Printf.sprintf "%s+git-%s"Compiler_version.s v in
+ match !show_version with
+ | `Number -> Format.printf "%s@." version
+ | `Full -> Format.printf "Js_of_ocaml compiler, version %s@." version
+ | `No ->
+ if !toplevel then linkall:=true;
+ let runtime = if !no_runtime then [] else ["+runtime.js"] in
+ let chop_extension s =
+ try Filename.chop_extension s with Invalid_argument _ -> s in
+ let output_f = match !output_file with
+ Some _ -> !output_file
+ | None -> Util.opt_map (fun s -> chop_extension s ^ ".js") !input_file in
+ let source_m =
+ if !source_map
+ then
+ match output_f with
+ | Some file ->
+ Some (
+ chop_extension file ^ ".map",
+ {
+ Source_map.version = 3;
+ file;
+ sourceroot = None;
+ sources = [];
+ sources_content = [];
+ names = [];
+ mappings = []
+ })
+ | None ->
+ failwith "Don't know where to output the Source-map@."
+ else None in
+ f !toplevel !linkall !paths !files (runtime @ List.rev !js_files)
+ !input_file output_f !output_file_fs source_m
+
+
+let _ =
+ try run () with
+ | (Match_failure _ | Assert_failure _ | Not_found) as exc ->
+ let backtrace = Printexc.get_backtrace () in
+ Format.eprintf
+ "%s: You found a bug. \
+ Please report it at https://github.com/ocsigen/js_of_ocaml/issues :@."
+ Sys.argv.(0);
+ Format.eprintf "Error: %s@." (Printexc.to_string exc);
+ prerr_string backtrace;
+ exit 1
+ | Util.MagicNumber.Bad_magic_number s ->
+ Format.eprintf "%s: Error: Not an ocaml executable bytecode@." Sys.argv.(0);
+ Format.eprintf "%s: Error: Invalid magic number %S, expecting %S@." Sys.argv.(0) s Util.MagicNumber.(to_string current);
+ exit 1
+ | Util.MagicNumber.Bad_magic_version h ->
+ Format.eprintf "%s: Error: Bytecode version missmatch. Got version %S, expecting %S.@."
+ Sys.argv.(0)
+ Util.MagicNumber.(to_string h)
+ Util.MagicNumber.(to_string current);
+ let comp =
+ if Util.MagicNumber.(compare h current) < 0
+ then "an older"
+ else "a newer" in
+ Format.eprintf "%s: Error: Your program and the js_of_ocaml compiler have to be compiled with the same version of ocaml.@." Sys.argv.(0);
+ Format.eprintf "%s: Error: The Js_of_ocaml compiler has been compiled with ocaml version %s.@." Sys.argv.(0) Sys.ocaml_version;
+ Format.eprintf "%s: Error: Its seems that your program has been compiled with %s version of ocaml.@." Sys.argv.(0) comp;
+ exit 1
+ | Failure s ->
+ Format.eprintf "%s: Error: %s@." Sys.argv.(0) s;
+ exit 1
+ | exc ->
+ Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc);
+ exit 1
diff -Nru js-of-ocaml-1.4/compiler/compiler_version.mli js-of-ocaml-2.2/compiler/compiler_version.mli
--- js-of-ocaml-1.4/compiler/compiler_version.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/compiler_version.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,22 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val s : string
+val git_version : string
diff -Nru js-of-ocaml-1.4/compiler/deadcode.ml js-of-ocaml-2.2/compiler/deadcode.ml
--- js-of-ocaml-1.4/compiler/deadcode.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/deadcode.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,8 +18,8 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let debug = Util.debug "deadcode"
-let times = Util.debug "times"
+let debug = Option.Debug.find "deadcode"
+let times = Option.Debug.find "times"
open Code
@@ -34,10 +34,8 @@
(****)
-let disabled = Util.disabled "deadcode"
-
let pure_expr pure_funs e =
- Pure_fun.pure_expr pure_funs e && not (disabled ())
+ Pure_fun.pure_expr pure_funs e && Option.Optim.deadcode ()
(****)
diff -Nru js-of-ocaml-1.4/compiler/deadcode.mli js-of-ocaml-2.2/compiler/deadcode.mli
--- js-of-ocaml-1.4/compiler/deadcode.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/deadcode.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,6 +18,4 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-val disabled : unit -> bool
-
val f : Code.program -> Code.program * int array
diff -Nru js-of-ocaml-1.4/compiler/.depend js-of-ocaml-2.2/compiler/.depend
--- js-of-ocaml-1.4/compiler/.depend 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/.depend 2014-05-15 08:37:39.000000000 +0000
@@ -1,82 +1,169 @@
-code.cmo : util.cmi code.cmi
-code.cmx : util.cmx code.cmi
+annot_lexer.cmo : annot_parser.cmi annot_lexer.cmi
+annot_lexer.cmx : annot_parser.cmx annot_lexer.cmi
+annot_parser.cmo : primitive.cmi annot_parser.cmi
+annot_parser.cmx : primitive.cmx annot_parser.cmi
+code.cmo : varPrinter.cmi util.cmi code.cmi
+code.cmx : varPrinter.cmx util.cmx code.cmi
+compile.cmo : util.cmi source_map.cmi pseudoFs.cmi pretty_print.cmi \
+ parse_bytecode.cmi option.cmi linker.cmi driver.cmi compiler_version.cmi \
+ code.cmi
+compile.cmx : util.cmx source_map.cmx pseudoFs.cmx pretty_print.cmx \
+ parse_bytecode.cmx option.cmx linker.cmx driver.cmx compiler_version.cmx \
+ code.cmx
+compiler_version.cmo : compiler_version.cmi
+compiler_version.cmx : compiler_version.cmi
control.cmo : subst.cmi code.cmi control.cmi
control.cmx : subst.cmx code.cmx control.cmi
-deadcode.cmo : util.cmi pure_fun.cmi code.cmi deadcode.cmi
-deadcode.cmx : util.cmx pure_fun.cmx code.cmx deadcode.cmi
+deadcode.cmo : util.cmi pure_fun.cmi option.cmi code.cmi deadcode.cmi
+deadcode.cmx : util.cmx pure_fun.cmx option.cmx code.cmx deadcode.cmi
dgraph.cmo : dgraph.cmi
dgraph.cmx : dgraph.cmi
-driver.cmo : util.cmi tailcall.cmi phisimpl.cmi parse_bytecode.cmi \
- js_output.cmi inline.cmi generate.cmi flow.cmi deadcode.cmi code.cmi \
- driver.cmi
-driver.cmx : util.cmx tailcall.cmx phisimpl.cmx parse_bytecode.cmx \
- js_output.cmx inline.cmx generate.cmx flow.cmx deadcode.cmx code.cmx \
- driver.cmi
-flow.cmo : util.cmi subst.cmi dgraph.cmi code.cmi flow.cmi
-flow.cmx : util.cmx subst.cmx dgraph.cmx code.cmx flow.cmi
-freevars.cmo : util.cmi code.cmi freevars.cmi
-freevars.cmx : util.cmx code.cmx freevars.cmi
-generate.cmo : util.cmi subst.cmi primitive.cmi pretty_print.cmi linker.cmi \
- js_simpl.cmi js_output.cmi javascript.cmi freevars.cmi code.cmi \
- generate.cmi
-generate.cmx : util.cmx subst.cmx primitive.cmx pretty_print.cmx linker.cmx \
- js_simpl.cmx js_output.cmx javascript.cmx freevars.cmx code.cmx \
- generate.cmi
-inline.cmo : deadcode.cmi code.cmi inline.cmi
-inline.cmx : deadcode.cmx code.cmx inline.cmi
-instr.cmo : instr.cmi
-instr.cmx : instr.cmi
-javascript.cmo : javascript.cmi
-javascript.cmx : javascript.cmi
-js_output.cmo : pretty_print.cmi javascript.cmi js_output.cmi
-js_output.cmx : pretty_print.cmx javascript.cmx js_output.cmi
-js_rename.cmo : util.cmi javascript.cmi
-js_rename.cmx : util.cmx javascript.cmx
-js_simpl.cmo : javascript.cmi js_simpl.cmi
-js_simpl.cmx : javascript.cmx js_simpl.cmi
-linker.cmo : util.cmi primitive.cmi pretty_print.cmi linker.cmi
-linker.cmx : util.cmx primitive.cmx pretty_print.cmx linker.cmi
-main.cmo : util.cmi pretty_print.cmi parse_bytecode.cmi linker.cmi \
- inline.cmi driver.cmi
-main.cmx : util.cmx pretty_print.cmx parse_bytecode.cmx linker.cmx \
- inline.cmx driver.cmx
-parse_bytecode.cmo : util.cmi primitive.cmi instr.cmi code.cmi \
- parse_bytecode.cmi
-parse_bytecode.cmx : util.cmx primitive.cmx instr.cmx code.cmx \
- parse_bytecode.cmi
-phisimpl.cmo : util.cmi subst.cmi dgraph.cmi code.cmi phisimpl.cmi
-phisimpl.cmx : util.cmx subst.cmx dgraph.cmx code.cmx phisimpl.cmi
+driver.cmo : varPrinter.cmi util.cmi tailcall.cmi specialize_js.cmi \
+ specialize.cmi reserved.cmi primitive.cmi pretty_print.cmi phisimpl.cmi \
+ parse_bytecode.cmi option.cmi linker.cmi js_traverse.cmi js_output.cmi \
+ js_assign.cmi javascript.cmi inline.cmi generate.cmi flow.cmi eval.cmi \
+ deadcode.cmi compiler_version.cmi code.cmi driver.cmi
+driver.cmx : varPrinter.cmx util.cmx tailcall.cmx specialize_js.cmx \
+ specialize.cmx reserved.cmx primitive.cmx pretty_print.cmx phisimpl.cmx \
+ parse_bytecode.cmx option.cmx linker.cmx js_traverse.cmx js_output.cmx \
+ js_assign.cmx javascript.cmx inline.cmx generate.cmx flow.cmx eval.cmx \
+ deadcode.cmx compiler_version.cmx code.cmx driver.cmi
+eval.cmo : primitive.cmi flow.cmi code.cmi eval.cmi
+eval.cmx : primitive.cmx flow.cmx code.cmx eval.cmi
+flow.cmo : util.cmi subst.cmi primitive.cmi option.cmi dgraph.cmi code.cmi \
+ flow.cmi
+flow.cmx : util.cmx subst.cmx primitive.cmx option.cmx dgraph.cmx code.cmx \
+ flow.cmi
+freevars.cmo : util.cmi option.cmi code.cmi freevars.cmi
+freevars.cmx : util.cmx option.cmx code.cmx freevars.cmi
+generate.cmo : util.cmi subst.cmi primitive.cmi parse_js.cmi parse_info.cmi \
+ option.cmi js_tailcall.cmi js_simpl.cmi javascript.cmi freevars.cmi \
+ code.cmi generate.cmi
+generate.cmx : util.cmx subst.cmx primitive.cmx parse_js.cmx parse_info.cmx \
+ option.cmx js_tailcall.cmx js_simpl.cmx javascript.cmx freevars.cmx \
+ code.cmx generate.cmi
+inline.cmo : code.cmi inline.cmi
+inline.cmx : code.cmx inline.cmi
+instr.cmo : util.cmi instr.cmi
+instr.cmx : util.cmx instr.cmi
+javascript.cmo : varPrinter.cmi util.cmi parse_info.cmi code.cmi \
+ javascript.cmi
+javascript.cmx : varPrinter.cmx util.cmx parse_info.cmx code.cmx \
+ javascript.cmi
+js_assign.cmo : util.cmi option.cmi js_traverse.cmi javascript.cmi code.cmi \
+ js_assign.cmi
+js_assign.cmx : util.cmx option.cmx js_traverse.cmx javascript.cmx code.cmx \
+ js_assign.cmi
+js_lexer.cmo : parse_info.cmi js_token.cmi js_lexer.cmi
+js_lexer.cmx : parse_info.cmx js_token.cmx js_lexer.cmi
+js_output.cmo : source_map.cmi pretty_print.cmi parse_info.cmi \
+ parse_bytecode.cmi option.cmi javascript.cmi js_output.cmi
+js_output.cmx : source_map.cmx pretty_print.cmx parse_info.cmx \
+ parse_bytecode.cmx option.cmx javascript.cmx js_output.cmi
+js_parser.cmo : parse_info.cmi js_token.cmi javascript.cmi js_parser.cmi
+js_parser.cmx : parse_info.cmx js_token.cmx javascript.cmx js_parser.cmi
+js_simpl.cmo : javascript.cmi code.cmi js_simpl.cmi
+js_simpl.cmx : javascript.cmx code.cmx js_simpl.cmi
+js_tailcall.cmo : option.cmi js_traverse.cmi javascript.cmi code.cmi \
+ js_tailcall.cmi
+js_tailcall.cmx : option.cmx js_traverse.cmx javascript.cmx code.cmx \
+ js_tailcall.cmi
+js_token.cmo : parse_info.cmi js_token.cmi
+js_token.cmx : parse_info.cmx js_token.cmi
+js_traverse.cmo : util.cmi javascript.cmi code.cmi js_traverse.cmi
+js_traverse.cmx : util.cmx javascript.cmx code.cmx js_traverse.cmi
+linker.cmo : util.cmi reserved.cmi primitive.cmi parse_js.cmi parse_info.cmi \
+ option.cmi js_traverse.cmi js_token.cmi javascript.cmi annot_parser.cmi \
+ annot_lexer.cmi linker.cmi
+linker.cmx : util.cmx reserved.cmx primitive.cmx parse_js.cmx parse_info.cmx \
+ option.cmx js_traverse.cmx js_token.cmx javascript.cmx annot_parser.cmx \
+ annot_lexer.cmx linker.cmi
+minify.cmo : util.cmi pretty_print.cmi parse_js.cmi parse_info.cmi \
+ option.cmi js_traverse.cmi js_output.cmi js_assign.cmi code.cmi
+minify.cmx : util.cmx pretty_print.cmx parse_js.cmx parse_info.cmx \
+ option.cmx js_traverse.cmx js_output.cmx js_assign.cmx code.cmx
+option.cmo : option.cmi
+option.cmx : option.cmi
+parse_bytecode.cmo : util.cmi primitive.cmi parse_info.cmi option.cmi \
+ javascript.cmi instr.cmi code.cmi parse_bytecode.cmi
+parse_bytecode.cmx : util.cmx primitive.cmx parse_info.cmx option.cmx \
+ javascript.cmx instr.cmx code.cmx parse_bytecode.cmi
+parse_info.cmo : parse_info.cmi
+parse_info.cmx : parse_info.cmi
+parse_js.cmo : parse_info.cmi js_token.cmi js_parser.cmi js_lexer.cmi \
+ parse_js.cmi
+parse_js.cmx : parse_info.cmx js_token.cmx js_parser.cmx js_lexer.cmx \
+ parse_js.cmi
+phisimpl.cmo : util.cmi subst.cmi option.cmi dgraph.cmi code.cmi \
+ phisimpl.cmi
+phisimpl.cmx : util.cmx subst.cmx option.cmx dgraph.cmx code.cmx \
+ phisimpl.cmi
pretty_print.cmo : pretty_print.cmi
pretty_print.cmx : pretty_print.cmi
-primitive.cmo : util.cmi primitive.cmi
-primitive.cmx : util.cmx primitive.cmi
+primitive.cmo : util.cmi parse_info.cmi primitive.cmi
+primitive.cmx : util.cmx parse_info.cmx primitive.cmi
+pseudoFs.cmo : util.cmi code.cmi pseudoFs.cmi
+pseudoFs.cmx : util.cmx code.cmx pseudoFs.cmi
pure_fun.cmo : primitive.cmi code.cmi pure_fun.cmi
pure_fun.cmx : primitive.cmx code.cmx pure_fun.cmi
+reserved.cmo : util.cmi reserved.cmi
+reserved.cmx : util.cmx reserved.cmi
+source_map.cmo : vlq64.cmi javascript.cmi source_map.cmi
+source_map.cmx : vlq64.cmx javascript.cmx source_map.cmi
+specialize.cmo : util.cmi option.cmi flow.cmi code.cmi specialize.cmi
+specialize.cmx : util.cmx option.cmx flow.cmx code.cmx specialize.cmi
+specialize_js.cmo : util.cmi flow.cmi code.cmi specialize_js.cmi
+specialize_js.cmx : util.cmx flow.cmx code.cmx specialize_js.cmi
subst.cmo : util.cmi code.cmi subst.cmi
subst.cmx : util.cmx code.cmx subst.cmi
-tailcall.cmo : util.cmi subst.cmi code.cmi tailcall.cmi
-tailcall.cmx : util.cmx subst.cmx code.cmx tailcall.cmi
+tailcall.cmo : util.cmi subst.cmi option.cmi code.cmi tailcall.cmi
+tailcall.cmx : util.cmx subst.cmx option.cmx code.cmx tailcall.cmi
util.cmo : util.cmi
util.cmx : util.cmi
+varPrinter.cmo : util.cmi reserved.cmi varPrinter.cmi
+varPrinter.cmx : util.cmx reserved.cmx varPrinter.cmi
+vlq64.cmo : vlq64.cmi
+vlq64.cmx : vlq64.cmi
+annot_lexer.cmi : annot_parser.cmi
+annot_parser.cmi : primitive.cmi
code.cmi : util.cmi
+compiler_version.cmi :
control.cmi : code.cmi
deadcode.cmi : code.cmi
dgraph.cmi :
-driver.cmi : pretty_print.cmi parse_bytecode.cmi code.cmi
+driver.cmi : source_map.cmi pretty_print.cmi parse_bytecode.cmi code.cmi
+eval.cmi : flow.cmi code.cmi
flow.cmi : code.cmi
freevars.cmi : util.cmi code.cmi
-generate.cmi : pretty_print.cmi parse_bytecode.cmi code.cmi
+generate.cmi : javascript.cmi code.cmi
inline.cmi : code.cmi
instr.cmi :
-javascript.cmi :
-js_output.cmi : pretty_print.cmi parse_bytecode.cmi javascript.cmi
-js_simpl.cmi : javascript.cmi
-linker.cmi : pretty_print.cmi
-parse_bytecode.cmi : code.cmi
+javascript.cmi : parse_info.cmi code.cmi
+js_assign.cmi : javascript.cmi
+js_lexer.cmi : parse_info.cmi js_token.cmi
+js_output.cmi : source_map.cmi pretty_print.cmi parse_bytecode.cmi \
+ javascript.cmi
+js_parser.cmi : js_token.cmi javascript.cmi
+js_simpl.cmi : javascript.cmi code.cmi
+js_tailcall.cmi : js_traverse.cmi javascript.cmi code.cmi
+js_token.cmi : parse_info.cmi
+js_traverse.cmi : util.cmi javascript.cmi code.cmi
+linker.cmi : util.cmi primitive.cmi parse_info.cmi javascript.cmi
+option.cmi :
+parse_bytecode.cmi : util.cmi parse_info.cmi javascript.cmi code.cmi
+parse_info.cmi :
+parse_js.cmi : parse_info.cmi js_token.cmi javascript.cmi
phisimpl.cmi : code.cmi
pretty_print.cmi :
-primitive.cmi :
+primitive.cmi : util.cmi parse_info.cmi
+pseudoFs.cmi : util.cmi code.cmi
pure_fun.cmi : code.cmi
+reserved.cmi : util.cmi
+source_map.cmi : javascript.cmi
+specialize.cmi : flow.cmi code.cmi
+specialize_js.cmi : flow.cmi code.cmi
subst.cmi : code.cmi
tailcall.cmi : code.cmi
util.cmi :
+varPrinter.cmi : util.cmi
+vlq64.cmi :
diff -Nru js-of-ocaml-1.4/compiler/driver.ml js-of-ocaml-2.2/compiler/driver.ml
--- js-of-ocaml-1.4/compiler/driver.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/driver.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,8 +18,11 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let debug = Util.debug "main"
-let times = Util.debug "times"
+let debug = Option.Debug.find "main"
+let times = Option.Debug.find "times"
+
+open Util
+
let tailcall p =
if debug () then Format.eprintf "Tail-call optimization...@.";
Tailcall.f p
@@ -33,17 +36,34 @@
in r
let inline p =
- let (p,live_vars) = deadcode' p in
- if debug () then Format.eprintf "Inlining...@.";
- Inline.f p live_vars
-
-let constant p =
-p
-(*
- let (p,_,defs) = deadcode' p in
- if debug () then Format.eprintf "Constant...@.";
- Constant.f p defs
-*)
+ if Option.Optim.inline () && Option.Optim.deadcode ()
+ then
+ let (p,live_vars) = deadcode' p in
+ if debug () then Format.eprintf "Inlining...@.";
+ Inline.f p live_vars
+ else p
+
+let specialize_1 (p,info) =
+ if debug () then Format.eprintf "Specialize...@.";
+ Specialize.f info p
+
+let specialize_js (p,info) =
+ if debug () then Format.eprintf "Specialize js...@.";
+ Specialize_js.f info p
+
+let specialize' (p,info) =
+ let p = specialize_1 (p,info)in
+ let p = specialize_js (p,info) in
+ p,info
+
+let specialize p =
+ fst (specialize' p)
+
+let eval (p,info) =
+ if Option.Optim.staticeval()
+ then Eval.f info p
+ else p
+
let flow p =
if debug () then Format.eprintf "Data flow...@.";
Flow.f p
@@ -63,7 +83,7 @@
let (>>) f g = fun x -> g (f x)
-let rec loop max name round i p =
+let rec loop max name round i (p : 'a) : 'a =
let p' = round p in
if i >= max || Code.eq p' p
then p'
@@ -78,39 +98,55 @@
(* o1 *)
-let o1 =
+let o1 : 'a -> 'a=
print >>
tailcall >>
+ flow_simple >> (* flow simple to keep information for furture tailcall opt *)
+ specialize' >>
+ eval >>
+ inline >> (* inlining may reveal new tailcall opt *)
+ deadcode >>
+ tailcall >>
phi >>
flow >>
+ specialize >>
inline >>
deadcode >>
print >>
flow >>
+ specialize >>
inline >>
deadcode >>
phi >>
flow >>
+ specialize >>
identity
(* o2 *)
-let o2 =
+let o2 : 'a -> 'a =
loop 10 "o1" o1 1 >>
print
(* o3 *)
-let round1 =
+let round1 : 'a -> 'a =
print >>
tailcall >>
inline >> (* inlining may reveal new tailcall opt *)
- constant >>
+ deadcode >>
+ (* deadcode required before flow simple -> provided by constant *)
flow_simple >> (* flow simple to keep information for furture tailcall opt *)
+ specialize' >>
+ eval >>
identity
let round2 =
- constant >> o1
+ flow >>
+ specialize' >>
+ eval >>
+ deadcode >>
+ o1
let o3 =
loop 10 "tailcall+inline" round1 1 >>
@@ -120,22 +156,298 @@
let profile = ref o1
-let f ?standalone ?linkall (p, d) =
- !profile p >>> deadcode' >>> fun (p,live_vars) ->
- fun formatter ->
- if times ()
- then Format.eprintf "Start Generation...@.";
- Generate.f formatter ?standalone ?linkall p d live_vars
-
-let from_string prims s =
- let p = Parse_bytecode.from_string prims s in
- f ~standalone:false p
+let generate (p,live_vars) =
+ if times ()
+ then Format.eprintf "Start Generation...@.";
+ Generate.f p live_vars
+
+
+let header formatter ~standalone js =
+ if standalone then begin
+ let version = match Compiler_version.git_version with
+ | "" -> Compiler_version.s
+ | v -> Printf.sprintf "%s+git-%s"Compiler_version.s v in
+
+ Pretty_print.string formatter
+ ("// Generated by js_of_ocaml " ^ version);
+
+ Pretty_print.newline formatter;
+ end;
+ js
+
+let debug_linker = Option.Debug.find "linker"
+
+let global_object = Option.global_object
+
+let extra_js_files = lazy (
+ List.fold_left (fun acc file ->
+ try
+ let ss = List.fold_left (fun ss (prov,_,_,_) ->
+ match prov with
+ | Some (_,name,_,_) -> StringSet.add name ss
+ | _ -> ss
+ ) StringSet.empty (Linker.parse_file file) in
+ (file,ss)::acc
+ with _ -> acc
+ ) [] Option.extra_js_files
+)
+
+let report_missing_primitives missing =
+ let missing = List.fold_left (fun missing (file,pro) ->
+ let d = StringSet.inter missing pro in
+ if not (StringSet.is_empty d)
+ then begin
+ Format.eprintf "Missing primitives provided by %s:@." file;
+ StringSet.iter (fun nm -> Format.eprintf " %s@." nm) d;
+ StringSet.diff missing pro
+ end
+ else missing
+ ) missing (Lazy.force extra_js_files) in
+ Format.eprintf "Missing primitives:@.";
+ StringSet.iter (fun nm -> Format.eprintf " %s@." nm) missing
+
+let gen_missing js missing =
+ let open Javascript in
+ let miss = StringSet.fold (fun prim acc ->
+ let p = S {name=prim;var=None} in
+ (p,
+ Some (
+ ECond(EBin(NotEqEq,
+ EDot(EVar (S {name=global_object;var=None}),prim),
+ EVar(S {name="undefined";var=None})),
+ EDot(EVar (S {name=global_object;var=None}),prim),
+ EFun(None,[],[
+ Statement(
+ Expression_statement (
+ ECall(EVar (S {name="caml_failwith";var=None}),
+ [EBin(Plus,EStr(prim,`Utf8),EStr(" not implemented",`Utf8))]),
+ N))],N)
+ ),
+ N
+ )) :: acc
+ ) missing [] in
+ if not (StringSet.is_empty missing)
+ then begin
+ Format.eprintf "There are some missing primitives@.";
+ Format.eprintf "Dummy implementations (raising 'Failure' exception) ";
+ Format.eprintf "will be used if they are not available at runtime.@.";
+ Format.eprintf "You can prevent the generation of dummy implementations with ";
+ Format.eprintf "the commandline option '-disable genprim'@.";
+ report_missing_primitives missing;
+ end;
+ Statement (Variable_statement miss) :: js
+
+
+let link formatter ~standalone ?linkall js =
+ if standalone
+ then
+ begin
+ let t = Util.Timer.make () in
+ if times ()
+ then Format.eprintf "Start Linking...@.";
+ let traverse = new Js_traverse.free in
+ let js = traverse#program js in
+ let free = traverse#get_free_name in
+
+ let prim = Primitive.get_external () in
+ let prov = Linker.get_provided () in
+
+ let all_external = StringSet.union prim prov in
+
+ let used = StringSet.inter free all_external in
+
+ let linkinfos = Linker.init () in
+ let linkinfos,missing = Linker.resolve_deps ?linkall linkinfos used in
+
+ (* gen_missing may use caml_failwith *)
+ let linkinfos,missing =
+ if not (StringSet.is_empty missing) && Option.Optim.genprim ()
+ then
+ let linkinfos,missing2 = Linker.resolve_deps linkinfos (StringSet.singleton "caml_failwith") in
+ linkinfos, StringSet.union missing missing2
+ else linkinfos, missing in
+
+ let js = if Option.Optim.genprim ()
+ then gen_missing js missing
+ else js in
+ if times () then Format.eprintf " linking: %a@." Util.Timer.print t;
+ Linker.link js linkinfos
+ end
+ else js
+
-let set_pretty () = Generate.set_pretty (); Parse_bytecode.set_pretty ()
+let check_js ~standalone js =
+ if standalone
+ then
+ begin
+ let t = Util.Timer.make () in
+ if times ()
+ then Format.eprintf "Start Checks...@.";
+
+ let traverse = new Js_traverse.free in
+ let js = traverse#program js in
+ let free = traverse#get_free_name in
+
+ let prim = Primitive.get_external () in
+ let prov = Linker.get_provided () in
+
+ let all_external = StringSet.union prim prov in
+
+ let missing = StringSet.inter free all_external in
+
+ let other = StringSet.diff free missing in
+
+ let res = VarPrinter.get_reserved() in
+ let other = StringSet.diff other res in
+ if not (StringSet.is_empty missing)
+ then begin
+ report_missing_primitives missing
+ end;
+
+ let probably_prov = StringSet.inter other Reserved.provided in
+ let other = StringSet.diff other probably_prov in
+
+ if not (StringSet.is_empty other) && debug_linker ()
+ then
+ begin
+ Format.eprintf "Missing variables:@.";
+ StringSet.iter (fun nm -> Format.eprintf " %s@." nm) other
+ end;
+
+ if not (StringSet.is_empty probably_prov) && debug_linker ()
+ then
+ begin
+ Format.eprintf "Variables provided by the browser:@.";
+ StringSet.iter (fun nm -> Format.eprintf " %s@." nm) probably_prov
+ end;
+ if times () then Format.eprintf " checks: %a@." Util.Timer.print t;
+ js
+ end
+ else js
-let set_debug_info () = Js_output.set_debug_info ()
+let coloring js =
+ let t = Util.Timer.make () in
+ if times ()
+ then Format.eprintf "Start Coloring...@.";
+ let traverse = new Js_traverse.free in
+ let js = traverse#program js in
+ let free = traverse#get_free_name in
+ VarPrinter.add_reserved (StringSet.elements free);
+ let js = Js_assign.program js in
+ if times () then Format.eprintf " coloring: %a@." Util.Timer.print t;
+ js
+
+let output formatter ?source_map d js =
+ let t = Util.Timer.make () in
+ if times ()
+ then Format.eprintf "Start Writing file...@.";
+ Js_output.program formatter ?source_map d js;
+ if times () then Format.eprintf " write: %a@." Util.Timer.print t
+
+let pack ~standalone ?(toplevel=false)?(linkall=false) js =
+ let module J = Javascript in
+ let t = Util.Timer.make () in
+ if times ()
+ then Format.eprintf "Start Optimizing js...@.";
+ (* pre pack optim *)
+ let js =
+ if Option.Optim.share_constant ()
+ then
+ let t1 = Util.Timer.make () in
+ let js = (new Js_traverse.share_constant)#program js in
+ if times () then Format.eprintf " share constant: %a@." Util.Timer.print t1;
+ js
+ else js in
+ let js =
+ if Option.Optim.compact_vardecl ()
+ then
+ let t2 = Util.Timer.make () in
+ let js = (new Js_traverse.compact_vardecl)#program js in
+ if times () then Format.eprintf " compact var decl: %a@." Util.Timer.print t2;
+ js
+ else js in
+
+ (* pack *)
+ let use_strict js =
+ if Option.Optim.strictmode ()
+ then J.Statement (J.Expression_statement (J.EStr ("use strict", `Utf8), J.N)) :: js
+ else js in
+
+ let global =
+ J.ECall (
+ J.EFun (None, [], [
+ J.Statement (
+ J.Return_statement(
+ Some (J.EVar (J.S {J.name="this";var=None})),
+ J.N))
+ ], J.N), []) in
+
+ let js = if standalone then
+ let f =
+ J.EFun (None, [J.S {J.name = global_object; var=None }], use_strict js,J.N) in
+ [J.Statement (
+ J.Expression_statement
+ ((J.ECall (f, [global])), J.N))]
+ else
+ let f = J.EFun (None, [J.V (Code.Var.fresh ())], js, J.N) in
+ [J.Statement (J.Expression_statement (f, J.N))] in
+
+ (* post pack optim *)
+ let t3 = Util.Timer.make () in
+ let js = (new Js_traverse.simpl)#program js in
+ if times () then Format.eprintf " simpl: %a@." Util.Timer.print t3;
+ let t4 = Util.Timer.make () in
+ let js = (new Js_traverse.clean)#program js in
+ if times () then Format.eprintf " clean: %a@." Util.Timer.print t4;
+ let js =
+ if (Option.Optim.shortvar ())
+ then
+ let t5 = Util.Timer.make () in
+ let keeps =
+ if toplevel
+ then StringSet.add global_object (Primitive.get_external ())
+ else StringSet.empty in
+ let keeps = StringSet.add "caml_get_global_data" keeps in
+ let js = (new Js_traverse.rename_variable keeps)#program js in
+ if times () then Format.eprintf " shortten vars: %a@." Util.Timer.print t5;
+ js
+ else js in
+ if times () then Format.eprintf " optimizing: %a@." Util.Timer.print t;
+ js
+
+
+
+let configure formatter p =
+ let pretty = Option.Optim.pretty () in
+ Pretty_print.set_compact formatter (not pretty);
+ Code.Var.set_pretty pretty;
+ p
+
+let f ?(standalone=true) ?toplevel ?linkall ?source_map formatter d =
+ configure formatter >>
+ !profile >>
+ deadcode' >>
+ generate >>
+
+ link formatter ~standalone ?linkall >>
+
+ pack ~standalone ?linkall ?toplevel >>
+
+ coloring >>
+
+ check_js ~standalone >>
+ header formatter ~standalone >>
+ output formatter ?source_map d
+
+let from_string prims s formatter =
+ let (p,d) = Parse_bytecode.from_string prims s in
+ f ~standalone:false formatter d p
let set_profile = function
+ | 0 ->
+ List.iter Option.Optim.enable ["pretty";"debuginfo"];
+ List.iter Option.Optim.disable ["inline";"staticeval"];
+ profile := o1
| 1 -> profile := o1
| 2 -> profile := o2
| 3 -> profile := o3
diff -Nru js-of-ocaml-1.4/compiler/driver.mli js-of-ocaml-2.2/compiler/driver.mli
--- js-of-ocaml-1.4/compiler/driver.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/driver.mli 2014-05-15 08:37:39.000000000 +0000
@@ -19,13 +19,12 @@
*)
val f :
- ?standalone:bool -> ?linkall:bool ->
- Code.program * Parse_bytecode.debug_loc -> Pretty_print.t -> unit
+ ?standalone:bool ->
+ ?toplevel:bool ->
+ ?linkall:bool ->
+ ?source_map:(string * Source_map.t) ->
+ Pretty_print.t -> Parse_bytecode.debug_loc -> Code.program -> unit
val from_string : string array -> string -> Pretty_print.t -> unit
-val set_pretty : unit -> unit
-
-val set_debug_info : unit -> unit
-
val set_profile : int -> unit
diff -Nru js-of-ocaml-1.4/compiler/eval.ml js-of-ocaml-2.2/compiler/eval.ml
--- js-of-ocaml-1.4/compiler/eval.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/eval.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,237 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Code
+open Flow
+
+
+module Int = Int32
+let int_binop l f = match l with
+ | [Int i; Int j] -> Some (Int (f i j))
+ | _ -> None
+let shift l f = match l with
+ | [Int i; Int j] -> Some (Int (f i ((Int32.to_int j) land 0x1f)))
+ | _ -> None
+let float_binop_aux l f =
+ let args = match l with
+ | [Float i; Float j]-> Some (i,j)
+ | [Int i ; Int j] -> Some (Int32.to_float i,Int32.to_float j)
+ | [Int i ; Float j] -> Some(Int32.to_float i,j)
+ | [Float i ; Int j] -> Some(i,Int32.to_float j)
+ | _ -> None in
+ match args with
+ | None -> None
+ | Some (i,j) -> Some (f i j)
+
+let float_binop l f = match float_binop_aux l f with
+ | Some x -> Some (Float x)
+ | None -> None
+
+let float_unop l f = match l with
+ | [Float i] -> Some (Float (f i))
+ | [Int i] -> Some (Float (f (Int32.to_float i)))
+ | _ -> None
+
+let float_binop_bool l f = match float_binop_aux l f with
+ | Some true -> Some (Int 1l)
+ | Some false -> Some (Int 0l)
+ | None -> None
+
+let bool b = Some (Int (if b then 1l else 0l))
+
+let eval_prim x =
+ match x with
+ | Not, [Int i] -> bool (i=0l)
+ | Lt, [Int i; Int j ] -> bool (i < j)
+ | Le, [Int i; Int j ] -> bool (i <= j)
+ | Eq, [Int i; Int j ] -> bool (i = j)
+ | Neq, [Int i; Int j ] -> bool (i <> j)
+ | IsInt, [Int _] -> bool true
+ | Ult, [Int i; Int j ] -> bool (j < 0l || i < j)
+ | Extern name, l ->
+ let name = Primitive.resolve name in
+ (match name, l with
+ (* int *)
+ | "%int_add", _ -> int_binop l (Int.add)
+ | "%int_sub", _ -> int_binop l (Int.sub)
+ | "%direct_int_mul", _ -> int_binop l (Int.mul )
+ | "%direct_int_div", [_; Int 0l] -> None
+ | "%direct_int_div", _ -> int_binop l (Int.div)
+ | "%direct_int_mod", _ -> int_binop l (Int.rem)
+ | "%int_and", _ -> int_binop l (Int.logand)
+ | "%int_or", _ -> int_binop l (Int.logor)
+ | "%int_xor", _ -> int_binop l (Int.logxor)
+ | "%int_lsl", _ -> shift l (Int.shift_left)
+ | "%int_lsr", _ -> shift l (Int.shift_right_logical)
+ | "%int_asr", _ -> shift l (Int.shift_right)
+ | "%int_neg", [Int i] -> Some (Int (Int.neg i ))
+ (* float *)
+ | "caml_eq_float", _ -> float_binop_bool l (=)
+ | "caml_neq_float", _ -> float_binop_bool l (<>)
+ | "caml_ge_float", _ -> float_binop_bool l (>=)
+ | "caml_le_float", _ -> float_binop_bool l (<=)
+ | "caml_gt_float", _ -> float_binop_bool l (>)
+ | "caml_lt_float", _ -> float_binop_bool l (<)
+ | "caml_add_float",_ -> float_binop l (+.)
+ | "caml_sub_float",_ -> float_binop l (-.)
+ | "caml_mul_float",_ -> float_binop l ( *. )
+ | "caml_div_float",_ -> float_binop l ( /. )
+ | "caml_fmod_float",_ -> float_binop l mod_float
+ | "caml_int_of_float",[Float f] -> Some (Int (Int32.of_float f))
+ | "to_int",[Float f] -> Some (Int (Int32.of_float f))
+ | "to_int",[Int i] -> Some (Int i)
+ (* Math *)
+ | "caml_abs_float",_ -> float_unop l abs_float
+ | "caml_acos_float",_ -> float_unop l acos
+ | "caml_asin_float",_ -> float_unop l asin
+ | "caml_atan_float",_ -> float_unop l atan
+ | "caml_atan2_float",_ -> float_binop l atan2
+ | "caml_ceil_float",_ -> float_unop l ceil
+ | "caml_cos_float",_ -> float_unop l cos
+ | "caml_exp_float",_ -> float_unop l exp
+ | "caml_floor_float",_ -> float_unop l floor
+ | "caml_log_float",_ -> float_unop l log
+ | "caml_power_float",_ -> float_binop l ( ** )
+ | "caml_sin_float",_ -> float_unop l sin
+ | "caml_sqrt_float",_ -> float_unop l sqrt
+ | "caml_tan_float",_ -> float_unop l tan
+ | _ -> None)
+ | _ -> None
+
+exception Not_constant
+
+let the_length_of info x =
+ get_approx info
+ (fun x ->
+ match info.info_defs.(Var.idx x) with
+ | Expr (Constant (String s))
+ | Expr (Constant (IString s)) -> Some (Int32.of_int (String.length s))
+ | Expr (Prim (Extern "caml_create_string",[arg])) ->
+ the_int info arg
+ | _ -> None)
+ None
+ (fun u v -> match u,v with
+ | Some l, Some l' when l = l' -> Some l
+ | _ -> None)
+ x
+
+
+let eval_instr info i =
+ match i with
+ | Let (x, Prim (Extern ("caml_js_equals"|"caml_equal"), [y;z])) ->
+ begin match the_const_of info y, the_const_of info z with
+ | Some e1, Some e2 ->
+ let c =
+ if e1 = e2
+ then 1l
+ else 0l in
+ Let (x , Constant (Int c))
+ | _ -> i
+ end
+ | Let (x,Prim (Extern "caml_ml_string_length", [s])) ->
+ let c = match s with
+ | Pc (String s)
+ | Pc (IString s) -> Some (Int32.of_int (String.length s))
+ | Pv v -> the_length_of info v
+ | _ -> None
+ in
+ (match c with
+ | None -> i
+ | Some c -> Let(x,Constant (Int c)))
+ | Let (x,Prim (prim, prim_args)) ->
+ begin
+ let prim_args' = List.map (fun x -> the_const_of info x) prim_args in
+ let res =
+ if List.for_all (function Some _ -> true | _ -> false) prim_args'
+ then eval_prim (prim,List.map (function Some c -> c | None -> assert false) prim_args')
+ else None in
+ match res with
+ | Some c -> Let (x,Constant c)
+ | _ -> Let(x, Prim(prim, (List.map2 (fun arg c ->
+ match c with
+ | Some ((Int _ | Float _) as c) -> Pc c
+ | Some _ (* do not be duplicated other constant as
+ they're not represented with constant in javascript. *)
+ | None -> arg) prim_args prim_args')))
+ end
+ | _ -> i
+
+type case_of = CConst of int | CTag of int | N
+
+let the_case_of info x =
+ match x with
+ | Pv x ->
+ get_approx info
+ (fun x -> match info.info_defs.(Var.idx x) with
+ | Expr (Const i)
+ | Expr (Constant (Int i)) -> CConst (Int32.to_int i)
+ | Expr (Block (j,_))
+ | Expr (Constant (Tuple (j,_))) -> CTag j
+ | _ -> N)
+ N
+ (fun u v -> match u, v with
+ | CTag i, CTag j when i = j -> u
+ | CConst i, CConst j when i = j -> u
+ | _ -> N)
+ x
+ | Pc (Int i) -> CConst (Int32.to_int i)
+ | Pc (Tuple (j,_)) -> CTag j
+ | _ -> N
+
+
+let eval_branch info = function
+ | Cond (cond,x,ftrue,ffalse) as b->
+ begin
+ match the_int info (Pv x) with
+ | Some j ->
+ let res = match cond with
+ | IsTrue -> (match j with 0l -> false | 1l -> true | _ -> assert false)
+ | CEq i -> i = j
+ | CLt i -> i < j
+ | CLe i -> i<= j
+ | CUlt i -> j < 0l || i < j
+ in
+ (match res with
+ | true -> Branch ftrue
+ | false -> Branch ffalse)
+ | _ -> b
+ end
+ | Switch (x,const,tags) as b ->
+ begin
+ match the_case_of info (Pv x) with
+ | CConst j -> Branch const.(j)
+ | CTag j -> Branch tags.(j)
+ | N -> b
+ end
+ | _ as b -> b
+
+
+
+let f info (pc, blocks, free_pc) =
+ let blocks =
+ AddrMap.map
+ (fun block ->
+ { block with
+ Code.body =
+ List.map (eval_instr info) block.body;
+ Code.branch = eval_branch info block.branch
+ })
+ blocks
+ in
+ (pc, blocks, free_pc)
diff -Nru js-of-ocaml-1.4/compiler/eval.mli js-of-ocaml-2.2/compiler/eval.mli
--- js-of-ocaml-1.4/compiler/eval.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/eval.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val f : Flow.info -> Code.program -> Code.program
diff -Nru js-of-ocaml-1.4/compiler/flow.ml js-of-ocaml-2.2/compiler/flow.ml
--- js-of-ocaml-1.4/compiler/flow.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/flow.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,9 +18,8 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let debug = Util.debug "flow"
-let disable_optcall = Util.disabled "optcall"
-let times = Util.debug "times"
+let debug = Option.Debug.find "flow"
+let times = Option.Debug.find "times"
open Code
@@ -30,6 +29,14 @@
type def = Phi of VarSet.t | Expr of Code.expr | Param
+type info = {
+ info_defs:def array;
+ info_known_origins : Code.VarSet.t Code.VarTbl.t;
+ info_maybe_unknown : bool Code.VarTbl.t;
+ info_possibly_mutable : bool array
+}
+
+
let undefined = Phi VarSet.empty
let is_undefined d = match d with Phi s -> VarSet.is_empty s | _ -> false
@@ -192,13 +199,32 @@
()
| Apply (_, l, _) ->
List.iter (fun x -> block_escape st x) l
- | Prim (_, l) ->
- List.iter
- (fun x ->
- match x with
- Pv x -> block_escape st x
- | Pc _ -> ())
- l
+ | Prim (prim, l) ->
+ let ka = match prim with
+ | Extern name -> Primitive.kind_args name
+ | _ -> None in
+ let ka = match ka with
+ | None -> []
+ | Some l -> l in
+ let rec loop args ka =
+ match args,ka with
+ | [], _ -> ()
+ | Pc _::ax, [] -> loop ax []
+ | Pv a::ax, [] -> block_escape st a; loop ax []
+ | a::ax, k::kx ->
+ begin match a,k with
+ | _,`Const
+ | Pc _, _ -> ()
+ | Pv v,`Shallow_const ->
+ begin match st.defs.(Var.idx v) with
+ | Expr (Block (_, a)) ->
+ Array.iter (fun x -> block_escape st x) a
+ | _ -> block_escape st v
+ end;
+ | Pv v, _ -> block_escape st v
+ end;
+ loop ax kx in
+ loop l ka
let program_escape defs known_origins (_, blocks, _) =
let nv = Var.count () in
@@ -246,8 +272,7 @@
let propagate2 ?(skip_param=false) defs known_origins possibly_mutable st x =
match defs.(Var.idx x) with
- Param ->
- true
+ Param -> skip_param
| Phi s ->
VarSet.exists (fun y -> VarTbl.get st y) s
| Expr e ->
@@ -261,14 +286,14 @@
(fun z ->
match defs.(Var.idx z) with
Expr (Block (_, a)) ->
- n >= Array.length a
- ||
- possibly_mutable.(Var.idx z)
- ||
- VarTbl.get st a.(n)
+ n >= Array.length a
+ ||
+ possibly_mutable.(Var.idx z)
+ ||
+ VarTbl.get st a.(n)
| Phi _ | Param | Expr _ ->
- true)
- (VarTbl.get known_origins y)
+ true)
+ (VarTbl.get known_origins y)
module Domain2 = struct
type t = bool
@@ -285,199 +310,54 @@
in
Solver2.f () g (propagate2 ?skip_param defs known_origins possibly_mutable)
-(****)
-
-let get_approx (defs, known_origins, maybe_unknown) f top join x =
- let s = VarTbl.get known_origins x in
- if VarTbl.get maybe_unknown x then top else
+let get_approx {info_defs; info_known_origins;info_maybe_unknown} f top join x =
+ let s = VarTbl.get info_known_origins x in
+ if VarTbl.get info_maybe_unknown x then top else
match VarSet.cardinal s with
0 -> top
| 1 -> f (VarSet.choose s)
| _ -> VarSet.fold (fun x u -> join (f x) u) s (f (VarSet.choose s))
-let the_def_of ((defs, _, _) as info) x =
+let the_def_of info x =
match x with
| Pv x ->
get_approx info
- (fun x -> match defs.(Var.idx x) with Expr e -> Some e | _ -> None)
+ (fun x -> match info.info_defs.(Var.idx x) with Expr e -> Some e | _ -> None)
None (fun u v -> None) x
| Pc c -> Some (Constant c)
-let the_int ((defs, _, _) as info) x =
+let rec the_const_of info x =
match x with
- | Pv x ->
- get_approx info
- (fun x -> match defs.(Var.idx x) with Expr (Const i) -> Some i | _ -> None)
- None
- (fun u v -> match u, v with Some i, Some j when i = j -> u | _ -> None)
- x
- | Pc (Int i) -> Some i
- | _ -> None
-
-let function_cardinality ((defs, _, _) as info) x =
- get_approx info
- (fun x ->
- match defs.(Var.idx x) with
- Expr (Closure (l, _)) -> Some (List.length l)
- | _ -> None)
- None
- (fun u v -> match u, v with Some n, Some m when n = m -> u | _ -> None)
- x
-
-let specialize_instr info i =
- match i with
- Let (x, Apply (f, l, _)) when not (disable_optcall ()) ->
- Let (x, Apply (f, l, function_cardinality info f))
-
-(*FIX this should be moved to a different file (javascript specific) *)
- | Let (x, Prim (Extern "caml_js_var", [y])) ->
- begin match the_def_of info y with
- Some (Constant (String _ as c)) ->
- Let (x, Prim (Extern "caml_js_var", [Pc c]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_const", [y])) ->
- begin match the_def_of info y with
- Some (Constant (String _ as c)) ->
- Let (x, Prim (Extern "caml_js_const", [Pc c]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_call", [f; o; a])) ->
- begin match the_def_of info a with
- Some (Block (_, a)) ->
- let a = Array.map (fun x -> Pv x) a in
- Let (x, Prim (Extern "caml_js_opt_call",
- f :: o :: Array.to_list a))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_fun_call", [f; a])) ->
- begin match the_def_of info a with
- Some (Block (_, a)) ->
- let a = Array.map (fun x -> Pv x) a in
- Let (x, Prim (Extern "caml_js_opt_fun_call",
- f :: Array.to_list a))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_meth_call", [o; m; a])) ->
- begin match the_def_of info m with
- Some (Constant (String _ as m)) ->
- begin match the_def_of info a with
- Some (Block (_, a)) ->
- let a = Array.map (fun x -> Pv x) a in
- Let (x, Prim (Extern "caml_js_opt_meth_call",
- o :: Pc m :: Array.to_list a))
- | _ ->
- i
- end
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_new", [c; a])) ->
- begin match the_def_of info a with
- Some (Block (_, a)) ->
- let a = Array.map (fun x -> Pv x) a in
- Let (x, Prim (Extern "caml_js_opt_new",
- c :: Array.to_list a))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_object", [a])) ->
- begin try
- let a =
- match the_def_of info a with
- Some (Block (_, a)) -> a
- | _ -> raise Exit
- in
- let a =
- Array.map
- (fun x ->
- match the_def_of info (Pv x) with
- Some (Block (_, [|k; v|])) ->
- let k =
- match the_def_of info (Pv k) with
- Some (Constant (String _ as s)) -> Pc s
- | _ -> raise Exit
- in
- [k; Pv v]
- | _ ->
- raise Exit)
- a
- in
- Let (x, Prim (Extern "caml_js_opt_object",
- List.flatten (Array.to_list a)))
- with Exit ->
- i
- end
- | Let (x, Prim (Extern "caml_js_get", [o; f])) ->
- begin match the_def_of info f with
- Some (Constant (String _ as c)) ->
- Let (x, Prim (Extern "caml_js_get", [o; Pc c]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_set", [o; f; v])) ->
- begin match the_def_of info f with
- Some (Constant (String _ as c)) ->
- Let (x, Prim (Extern "caml_js_set", [o; Pc c; v]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "caml_js_delete", [o; f])) ->
- begin match the_def_of info f with
- Some (Constant (String _ as c)) ->
- Let (x, Prim (Extern "caml_js_delete", [o; Pc c]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "%int_mul", [y; z])) ->
- begin match the_int info y, the_int info z with
- Some j, _ | _, Some j when abs j < 0x200000 ->
- Let (x, Prim (Extern "%direct_int_mul", [y; z]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "%int_div", [y; z])) ->
- begin match the_int info z with
- Some j when j <> 0 ->
- Let (x, Prim (Extern "%direct_int_div", [y; z]))
- | _ ->
- i
- end
- | Let (x, Prim (Extern "%int_mod", [y; z])) ->
- begin match the_int info z with
- Some j when j <> 0 ->
- Let (x, Prim (Extern "%direct_int_mod", [y; z]))
- | _ ->
- i
- end
+ | Pv x ->
+ get_approx info
+ (fun x -> match info.info_defs.(Var.idx x) with
+ | Expr (Const i) -> Some (Int i)
+ | Expr (Constant c) -> Some c
+ | _ -> None)
+ None
+ (fun u v -> match u, v with Some i, Some j when i = j -> u | _ -> None)
+ x
+ | Pc c -> Some c
- | _ ->
- i
-let specialize_instrs info (pc, blocks, free_pc) =
- let blocks =
- AddrMap.map
- (fun block ->
- { block with Code.body =
- List.map (fun i -> specialize_instr info i) block.body })
- blocks
- in
- (pc, blocks, free_pc)
-
-(****)
+let the_int info x =
+ match the_const_of info x with
+ | Some (Int i) -> Some i
+ | _ -> None
+
+let the_string_of info x =
+ match the_const_of info x with
+ | Some (String i) -> Some i
+ | _ -> None
(*XXX Maybe we could iterate? *)
-let direct_approx defs known_origins maybe_unknown possibly_mutable x =
- match defs.(Var.idx x) with
+let direct_approx info x =
+ match info.info_defs.(Var.idx x) with
Expr (Field (y, n)) ->
- get_approx (defs, known_origins, maybe_unknown)
+ get_approx info
(fun z ->
- if possibly_mutable.(Var.idx z) then None else
- match defs.(Var.idx z) with
+ if info.info_possibly_mutable.(Var.idx z) then None else
+ match info.info_defs.(Var.idx z) with
Expr (Block (_, a)) when n < Array.length a ->
Some a.(n)
| _ ->
@@ -491,20 +371,23 @@
| _ ->
None
-let build_subst defs vars known_origins maybe_unknown possibly_mutable =
+let build_subst info vars =
let nv = Var.count () in
let subst = Array.make nv None in
VarISet.iter
(fun x ->
- let u = VarTbl.get maybe_unknown x in
+ let u = VarTbl.get info.info_maybe_unknown x in
if not u then begin
- let s = VarTbl.get known_origins x in
+ let s = VarTbl.get info.info_known_origins x in
if VarSet.cardinal s = 1 then
subst.(Var.idx x) <- Some (VarSet.choose s)
end;
if subst.(Var.idx x) = None then
- subst.(Var.idx x) <-
- direct_approx defs known_origins maybe_unknown possibly_mutable x)
+ subst.(Var.idx x) <- direct_approx info x;
+ match subst.(Var.idx x) with
+ | None -> ()
+ | Some y -> Var.propagate_name x y
+ )
vars;
subst
@@ -538,9 +421,14 @@
end;
let t5 = Util.Timer.make () in
- let p = specialize_instrs (defs, known_origins, maybe_unknown) p in
- let s = build_subst defs vars known_origins maybe_unknown possibly_mutable in
+ let info = {
+ info_defs = defs;
+ info_known_origins = known_origins;
+ info_maybe_unknown = maybe_unknown;
+ info_possibly_mutable = possibly_mutable;
+ } in
+ let s = build_subst info vars in
let p = Subst.program (Subst.from_array s) p in
if times () then Format.eprintf " flow analysis 5: %a@." Util.Timer.print t5;
if times () then Format.eprintf " flow analysis: %a@." Util.Timer.print t;
- p
+ p, info
diff -Nru js-of-ocaml-1.4/compiler/flow.mli js-of-ocaml-2.2/compiler/flow.mli
--- js-of-ocaml-1.4/compiler/flow.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/flow.mli 2014-05-15 08:37:39.000000000 +0000
@@ -37,4 +37,24 @@
*)
-val f : ?skip_param:bool -> Code.program -> Code.program (* * t array*)
+type def = Phi of Code.VarSet.t | Expr of Code.expr | Param
+
+type info = {
+ info_defs:def array;
+ info_known_origins : Code.VarSet.t Code.VarTbl.t;
+ info_maybe_unknown : bool Code.VarTbl.t;
+ info_possibly_mutable : bool array;
+}
+
+val get_approx : info -> (Code.VarSet.elt -> 'b) ->
+ 'b -> ('b -> 'b -> 'b) -> Code.VarTbl.key -> 'b
+
+val the_def_of : info -> Code.prim_arg -> Code.expr option
+
+val the_const_of : info -> Code.prim_arg -> Code.constant option
+
+val the_string_of : info -> Code.prim_arg -> string option
+
+val the_int : info -> Code.prim_arg -> int32 option
+
+val f : ?skip_param:bool -> Code.program -> Code.program * info
diff -Nru js-of-ocaml-1.4/compiler/freevars.ml js-of-ocaml-2.2/compiler/freevars.ml
--- js-of-ocaml-1.4/compiler/freevars.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/freevars.ml 2014-05-15 08:37:39.000000000 +0000
@@ -19,7 +19,7 @@
*)
-let times = Util.debug "times"
+let times = Option.Debug.find "times"
open Code
diff -Nru js-of-ocaml-1.4/compiler/generate.ml js-of-ocaml-2.2/compiler/generate.ml
--- js-of-ocaml-1.4/compiler/generate.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/generate.ml 2014-05-15 08:37:39.000000000 +0000
@@ -33,16 +33,11 @@
- CLEAN UP!!!
*)
-let compact = ref true
-let debug = Util.debug "gen"
-let times = Util.debug "times"
-let disable_compact_expr = Util.disabled "compactexpr"
-
-let set_pretty () = compact := false
-
-(****)
+let debug = Option.Debug.find "gen"
+let times = Option.Debug.find "times"
open Code
+open Util
module J = Javascript
@@ -66,40 +61,168 @@
(****)
+module Share = struct
+ type 'a aux = {
+ strings : 'a StringMap.t;
+ applies : 'a IntMap.t;
+ prims : 'a StringMap.t;
+ }
+
+
+ let empty_aux = { prims = StringMap.empty;
+ strings = StringMap.empty;
+ applies = IntMap.empty }
+
+ type t = {
+ mutable count : int aux;
+ mutable vars : J.ident aux;
+ }
+
+ let add_string s t =
+ let n = try StringMap.find s t.strings with Not_found -> 0 in
+ {t with strings = StringMap.add s (n+1) t.strings}
+
+ let add_prim s t =
+ let n = try StringMap.find s t.prims with Not_found -> 0 in
+ {t with prims = StringMap.add s (n+1) t.prims}
+
+ let add_special_prim_if_exists s t =
+ if Primitive.exists s
+ then {t with prims = StringMap.add s (-1) t.prims}
+ else t
+
+ let add_apply i t =
+ let n = try IntMap.find i t.applies with Not_found -> 0 in
+ {t with applies = IntMap.add i (n+1) t.applies }
+
+ let add_code_string s share =
+ let share = add_string s share in
+ add_prim "caml_new_string" share
+
+ let add_code_istring s share =
+ add_string s share
+
+ let rec get_constant c t =
+ match c with
+ | String s -> add_code_string s t
+ | IString s -> add_code_istring s t
+ | Tuple (_,args) -> Array.fold_left (fun t c ->
+ get_constant c t) t args
+ | _ -> t
+
+ let add_args args t =
+ List.fold_left(fun t a ->
+ match a with
+ | Pc c -> get_constant c t
+ | _ -> t) t args
+
+
+ let get (_, blocks, _) : t =
+ let count = AddrMap.fold
+ (fun _ block share ->
+ List.fold_left
+ (fun share i ->
+ match i with
+ | Let (_, Constant c) -> get_constant c share
+ | Let (_, Apply (_,args,false)) ->
+ add_apply (List.length args) share
+ | Let (_, Prim (Extern name, args)) ->
+ let name = Primitive.resolve name in
+ let share =
+ if Primitive.exists name
+ then add_prim name share
+ else share in
+ add_args args share
+ | Let (_, Prim (_, args)) ->
+ add_args args share
+ | _ -> share
+ )
+ share block.body)
+ blocks empty_aux in
+
+ let count = List.fold_left (fun acc x ->
+ add_special_prim_if_exists x acc)
+ count
+ ["caml_trampoline";"caml_trampoline_return";"caml_wrap_exception"] in
+ {count; vars = empty_aux}
+
+ let get_string gen s t =
+ (* disabled because it is done later on Js ast *)
+ (* try *)
+ (* let c = StringMap.find s t.count.strings in *)
+ (* if c > 1 *)
+ (* then *)
+ (* try *)
+ (* J.EVar (StringMap.find s t.vars.strings) *)
+ (* with Not_found -> *)
+ (* let x = Var.fresh() in *)
+ (* Var.name x "str"; *)
+ (* let v = J.V x in *)
+ (* t.vars <- { t.vars with strings = StringMap.add s v t.vars.strings }; *)
+ (* J.EVar v *)
+ (* else *)
+ (* gen s *)
+ (* with Not_found-> *)
+ gen s
+
+ let get_prim gen s t =
+ let s = Primitive.resolve s in
+ try
+ let c = StringMap.find s t.count.prims in
+ if c > 1 || c = -1
+ then
+ try
+ J.EVar (StringMap.find s t.vars.prims)
+ with Not_found ->
+ let x = Var.fresh() in
+ Code.Var.name x s;
+ let v = J.V x in
+ t.vars <- { t.vars with prims = StringMap.add s v t.vars.prims };
+ J.EVar v
+ else
+ gen s
+ with Not_found ->
+ gen s
+
+
+ let get_apply gen n t =
+ try
+ let c = IntMap.find n t.count.applies in
+ if c > 1
+ then
+ try
+ J.EVar (IntMap.find n t.vars.applies)
+ with Not_found ->
+ let x = Var.fresh() in
+ Code.Var.name x (Printf.sprintf "caml_call_gen%d" n);
+ let v = J.V x in
+ t.vars <- { t.vars with applies = IntMap.add n v t.vars.applies };
+ J.EVar v
+ else
+ gen n
+ with Not_found ->
+ gen n
+
+end
+
+
module Ctx = struct
type t =
- { var_stream : Var.stream;
- mutable blocks : block AddrMap.t;
+ { mutable blocks : block AddrMap.t;
live : int array;
- mutated_vars : VarSet.t AddrMap.t }
-
- let fresh_var ctx =
- let (x, stream) = Var.next ctx.var_stream in
- (x, {ctx with var_stream = stream})
+ mutated_vars : VarSet.t AddrMap.t;
+ share: Share.t }
- let initial b l v =
- { var_stream = Var.make_stream (); blocks = b; live = l; mutated_vars = v }
+ let initial b l v share =
+ { blocks = b; live = l; mutated_vars = v; share }
- let used_once ctx x = ctx.live.(Var.idx x) <= 1
end
-let add_names = Hashtbl.create 101
-
-let var x = J.EVar (Var.to_string x)
+let var x = J.EVar (J.V x)
let int n = J.ENum (float n)
+let int32 n = J.ENum (Int32.to_float n)
let one = int 1
let zero = int 0
-let addr pc =
- if not !compact then
- Format.sprintf "f%d" pc
- else begin
- try
- Hashtbl.find add_names pc
- with Not_found ->
- let x = Var.to_string (Var.fresh ()) in
- Hashtbl.replace add_names pc x;
- x
- end
let bool e = J.ECond (e, one, zero)
let boolnot e = J.ECond (e, zero, one)
let val_float f = f (*J.EArr [Some (J.ENum 253.); Some f]*)
@@ -109,30 +232,10 @@
let float_const f = val_float (J.ENum f)
-let rec constant x =
- match x with
- String s ->
- Primitive.mark_used "MlString";
- J.ENew (J.EVar ("MlString"), Some [J.EStr (s, `Bytes)])
- | Float f ->
- float_const f
- | Float_array a ->
- J.EArr (Some (int Obj.double_array_tag) ::
- Array.to_list (Array.map (fun f -> Some (float_const f)) a))
- | Int32 i ->
- J.ENum (Int32.to_float i)
- | Nativeint i ->
- J.ENum (Nativeint.to_float i)
- | Int64 i ->
- J.EArr [Some (int 255);
- Some (int (Int64.to_int i land 0xffffff));
- Some (int (Int64.to_int (Int64.shift_right i 24) land 0xffffff));
- Some (int (Int64.to_int (Int64.shift_right i 48) land 0xffff))]
- | Tuple (tag, a) ->
- J.EArr (Some (int tag) ::
- Array.to_list (Array.map (fun x -> Some (constant x)) a))
- | Int i ->
- int i
+let s_var name = J.EVar (J.S {J.name=name; J.var = None})
+
+let str_js s = J.EStr (s,`Bytes)
+
(****)
@@ -157,39 +260,139 @@
match k with
`Pure -> const_p | `Mutable -> mutable_p | `Mutator -> mutator_p
+let max_depth = 10
+
+let rec constant_rec ~ctx x level instrs =
+ match x with
+ String s ->
+ let e = Share.get_string str_js s ctx.Ctx.share in
+ let p = Share.get_prim s_var "caml_new_string" ctx.Ctx.share in
+ J.ECall (p,[e]), instrs
+ | IString s ->
+ Share.get_string str_js s ctx.Ctx.share, instrs
+ | Float f ->
+ float_const f, instrs
+ | Float_array a ->
+ J.EArr (Some (int Obj.double_array_tag) ::
+ Array.to_list (Array.map (fun f -> Some (float_const f)) a)),
+ instrs
+ | Int64 i ->
+ J.EArr [Some (int 255);
+ Some (int (Int64.to_int i land 0xffffff));
+ Some (int (Int64.to_int (Int64.shift_right i 24) land 0xffffff));
+ Some (int (Int64.to_int (Int64.shift_right i 48) land 0xffff))],
+ instrs
+ | Tuple (tag, a) ->
+ let split = level = max_depth in
+ let level = if split then 0 else level + 1 in
+ let (l, instrs) =
+ List.fold_left
+ (fun (l, instrs) cc ->
+ let (js, instrs) = constant_rec ~ctx cc level instrs in
+ js::l, instrs)
+ ([], instrs) (Array.to_list a)
+ in
+ let (l, instrs) =
+ if split then
+ List.fold_left
+ (fun (acc,instrs) js ->
+ match js with
+ | J.EArr _ ->
+ let v = Code.Var.fresh () in
+ Var.name v "partial";
+ let instrs =
+ J.Variable_statement [J.V v, Some (js,J.N)] :: instrs in
+ Some (J.EVar (J.V v))::acc,instrs
+ | _ ->
+ Some js :: acc,instrs)
+ ([],instrs) l
+ else
+ List.rev_map (fun x -> Some x) l, instrs
+ in
+ J.EArr (Some (int tag) :: l), instrs
+ | Int i-> int32 i, instrs
+
+let constant ~ctx x level =
+ let (expr, instr) = constant_rec ~ctx x level [] in
+ (expr, List.rev instr)
+
+
+type queue_elt = {
+ prop : int;
+ cardinal : int;
+ ce : J.expression;
+ pc : int;
+ deps : Code.VarSet.t
+}
+
let access_queue queue x =
try
- let res = List.assoc x queue in
- (res, List.remove_assoc x queue)
+ let elt = List.assoc x queue in
+ if elt.cardinal = 1
+ then
+ (elt.prop,elt.ce), List.remove_assoc x queue
+ else
+ ((elt.prop,elt.ce), List.map (function (x',elt) when x = x' -> x',{elt with cardinal=pred elt.cardinal} | x -> x) queue)
with Not_found ->
((const_p, var x), queue)
+let access_queue' ~ctx queue x =
+ match x with
+ | Pc c ->
+ let js,instrs = constant ~ctx c max_depth in
+ assert (instrs = []); (* We only have simple constants here *)
+ (const_p, js), queue
+ | Pv x -> access_queue queue x
+
+let access_queue_may_flush queue v x =
+ let tx,queue = access_queue queue x in
+ let _,instrs,queue = List.fold_left (fun (deps,instrs,queue) ((y,elt) as eq) ->
+ if Code.VarSet.exists (fun p -> Code.VarSet.mem p deps) elt.deps
+ then (Code.VarSet.add ( y) deps),
+ (J.Variable_statement [J.V y,
+ Some (elt.ce,
+ J.Loc (DebugAddr.of_addr elt.pc))]
+ :: instrs),
+ queue
+ else deps,instrs,(eq::queue)
+ ) (Code.VarSet.singleton ( v),[],[]) queue
+ in instrs,(tx,List.rev queue)
+
+
+
let should_flush cond prop = cond <> const_p && cond + prop >= flush_p
let flush_queue expr_queue prop l =
let (instrs, expr_queue) =
if prop >= flush_p then (expr_queue, []) else
- List.partition (fun (y, (p, _)) -> should_flush prop p) expr_queue
+ List.partition (fun (y, elt) -> should_flush prop elt.prop) expr_queue
in
let instrs =
- List.map (fun (x, (_, ce)) ->
+ List.map (fun (x, elt) ->
J.Variable_statement
- [Var.to_string x, Some ce]) instrs
+ [J.V x, Some (elt.ce,J.Loc (DebugAddr.of_addr elt.pc))])
+ instrs
in
(List.rev_append instrs l, expr_queue)
let flush_all expr_queue l = fst (flush_queue expr_queue flush_p l)
-let enqueue expr_queue prop x ce =
+let enqueue expr_queue prop x ce pc cardinal acc =
let (instrs, expr_queue) =
- if disable_compact_expr () then
- flush_queue expr_queue flush_p []
- else if is_mutable prop then
- flush_queue expr_queue prop []
- else
- [], expr_queue
+ if Option.Optim.compact () then
+ if is_mutable prop then
+ flush_queue expr_queue prop []
+ else
+ [], expr_queue
+ else flush_queue expr_queue flush_p []
in
- (instrs, (x, (prop, ce)) :: expr_queue)
+ let deps = Js_simpl.get_variable Code.VarSet.empty ce in
+ let deps = List.fold_left (fun deps (x',elt) ->
+ if Code.VarSet.mem ( x') deps
+ then Code.VarSet.union elt.deps deps
+ else deps) deps expr_queue
+ in
+ (instrs @ acc , (x, {prop; ce; pc; cardinal; deps}) :: expr_queue)
(****)
@@ -199,7 +402,7 @@
backs : (int, AddrSet.t) Hashtbl.t;
preds : (int, int) Hashtbl.t;
mutable loops : AddrSet.t;
- mutable loop_stack : (addr * (int * bool ref)) list;
+ mutable loop_stack : (addr * (J.Label.t * bool ref)) list;
mutable visited_blocks : AddrSet.t;
mutable interm_idx : int;
ctx : Ctx.t; mutable blocks : Code.block AddrMap.t }
@@ -256,9 +459,6 @@
let rec dominance_frontier_rec st pc visited grey =
let n = get_preds st pc in
let v = try AddrMap.find pc visited with Not_found -> 0 in
-(*
-Format.eprintf "%d %d %d@." pc n v;
-*)
if v < n then begin
let v = v + 1 in
let visited = AddrMap.add pc v visited in
@@ -283,26 +483,9 @@
let never_continue st (pc, _) frontier interm succs =
(* If not found in successors, this is a backward edge *)
let d = try List.assoc pc succs with Not_found -> AddrSet.empty in
-(*
-Format.eprintf "pc: %d@." pc;
-List.iter (fun (pc, _) ->Format.eprintf "pc: %d@." pc) succs;
-Format.eprintf "never_continue@.";
-Format.eprintf " %d /" pc;
-AddrSet.iter (fun i -> Format.eprintf " %d" i) frontier;
-Format.eprintf " /";
-AddrMap.iter (fun i _ -> Format.eprintf " %d" i) interm;
-Format.eprintf " /";
-AddrSet.iter (fun i -> Format.eprintf " %d" i) d;
-let res =
-*)
not (AddrSet.mem pc frontier || AddrMap.mem pc interm)
&&
AddrSet.is_empty d
-(*
-in
-Format.eprintf " ==> %b@." res;
-res
-*)
let rec resolve_node interm pc =
try
@@ -353,58 +536,47 @@
let l = List.rev (visit_all params args) in
List.fold_left
(fun continuation (y, x) ->
- fun queue ->
- let ((px, cx), queue) = access_queue queue x in
- let (st, queue) =
-(*
- let idx = Var.idx y in
- let len = Array.length ctx.Ctx.live in
- match if idx >= len then 2 else ctx.Ctx.live.(Var.idx y) with
- 0 -> assert false
- | 1 -> enqueue queue px y cx
- | _ -> *)
- flush_queue queue px [J.Variable_statement [Var.to_string y, Some cx]]
- in
- st @ continuation queue)
+ fun queue ->
+ let instrs,((px, cx), queue) = access_queue_may_flush queue y x in
+ let (st, queue) = flush_queue queue px (instrs@[J.Variable_statement [ J.V y, Some (cx,J.N)]])
+ in
+ st @ continuation queue)
continuation l queue
(****)
-let apply_funs = ref Util.IntMap.empty
-
-let get_apply_fun n =
- try
- Util.IntMap.find n !apply_funs
- with Not_found ->
- Primitive.mark_used "caml_call_gen";
- let x = Var.fresh () in
- apply_funs := Util.IntMap.add n x !apply_funs;
- x
-
-let generate_apply_funs cont =
- let funs = !apply_funs in
- apply_funs := Util.IntMap.empty;
- Util.IntMap.fold
- (fun n x cont ->
- let f = Var.to_string (Var.fresh ()) in
- let params =
- Array.to_list (Array.init n (fun _ -> Var.to_string (Var.fresh ())))
- in
- let f' = J.EVar f in
- let params' = List.map (fun x -> J.EVar x) params in
- J.Function_declaration
- (Var.to_string x, f :: params,
+let apply_fun_raw f params =
+ let n = List.length params in
+ J.ECond (J.EBin (J.EqEq, J.EDot (f, "length"),
+ J.ENum (float n)),
+ J.ECall (f, params),
+ J.ECall (s_var "caml_call_gen",
+ [f; J.EArr (List.map (fun x -> Some x) params)]))
+
+let generate_apply_fun n =
+ let f' = Var.fresh () in
+ let f = J.V f' in
+ Code.Var.name f' "fun";
+ let params =
+ Array.to_list (Array.init n (fun i ->
+ let a = Var.fresh () in
+ Var.name a ("var"^(string_of_int i));
+ J.V a))
+ in
+ let f' = J.EVar f in
+ let params' = List.map (fun x -> J.EVar x) params in
+ J.EFun (None, f :: params,
[J.Statement
- (J.Return_statement
- (Some
- (J.ECond (J.EBin (J.EqEq, J.EDot (f', "length"),
- J.ENum (float n)),
- J.ECall (f', params'),
- J.ECall (J.EVar "caml_call_gen",
- [f'; J.EArr (List.map (fun x -> Some x) params')])))))],
- None) ::
- cont)
- funs cont
+ (J.Return_statement
+ (Some (apply_fun_raw f' params'), J.N))],
+ J.N)
+
+let apply_fun ctx f params =
+ if Option.Optim.inline_callgen ()
+ then apply_fun_raw f params
+ else
+ let y = Share.get_apply generate_apply_fun (List.length params) ctx.Ctx.share in
+ J.ECall (y, f::params)
(****)
@@ -478,60 +650,72 @@
try Hashtbl.find internal_primitives name with Not_found -> None
let register_prim name k f =
- Primitive.register name k;
+ Primitive.register name k None None;
Hashtbl.add internal_primitives name (Some f)
let register_un_prim name k f =
register_prim name k
- (fun l queue ->
+ (fun l queue ctx ->
match l with
- [Pv x] ->
- let ((px, cx), queue) = access_queue queue x in
+ [x] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
(f cx, or_p (kind k) px, queue)
- | _ ->
+ | _ ->
+ assert false)
+
+let register_un_prim_ctx name k f =
+ register_prim name k
+ (fun l queue ctx ->
+ match l with
+ [x] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ (f ctx cx, or_p (kind k) px, queue)
+ | _ ->
assert false)
let register_bin_prim name k f =
register_prim name k
- (fun l queue ->
+ (fun l queue ctx ->
match l with
- [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
+ [x;y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
(f cx cy, or_p (kind k) (or_p px py), queue)
- | _ ->
- assert false)
+ | _ -> assert false)
let register_tern_prim name f =
register_prim name `Mutator
- (fun l queue ->
+ (fun l queue ctx ->
match l with
- [Pv x; Pv y; Pv z] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- let ((pz, cz), queue) = access_queue queue z in
+ [x;y;z] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ let ((pz, cz), queue) = access_queue' ~ctx queue z in
(f cx cy cz, or_p mutator_p (or_p px (or_p py pz)), queue)
- | _ ->
+ | _ ->
assert false)
let register_un_math_prim name prim =
register_un_prim name `Pure
- (fun cx -> J.ECall (J.EDot (J.EVar "Math", prim), [cx]))
+ (fun cx -> J.ECall (J.EDot (s_var "Math", prim), [cx]))
let register_bin_math_prim name prim =
register_bin_prim name `Pure
- (fun cx cy -> J.ECall (J.EDot (J.EVar "Math", prim), [cx; cy]))
+ (fun cx cy -> J.ECall (J.EDot (s_var "Math", prim), [cx; cy]))
let _ =
- Code.add_reserved_name "Math";
+ register_un_prim_ctx "%caml_format_int_special" `Pure
+ (fun ctx cx ->
+ let p = Share.get_prim s_var "caml_new_string" ctx.Ctx.share in
+ J.ECall (p, [J.EBin (J.Plus,str_js "",cx)]));
register_bin_prim "caml_array_unsafe_get" `Mutable
(fun cx cy -> J.EAccess (cx, J.EBin (J.Plus, cy, one)));
register_bin_prim "caml_string_get" `Mutable
(fun cx cy -> J.ECall (J.EDot (cx, "safeGet"), [cy]));
register_bin_prim "%int_add" `Pure
- (fun cx cy -> Js_simpl.eplus_int cx cy);
+ (fun cx cy -> to_int (J.EBin (J.Plus,cx,cy)));
register_bin_prim "%int_sub" `Pure
- (fun cx cy -> Js_simpl.eminus_int cx cy);
+ (fun cx cy -> to_int (J.EBin (J.Minus,cx,cy)));
register_bin_prim "%direct_int_mul" `Pure
(fun cx cy -> to_int (J.EBin (J.Mul, cx, cy)));
register_bin_prim "%direct_int_div" `Pure
@@ -551,7 +735,7 @@
register_bin_prim "%int_asr" `Pure
(fun cx cy -> J.EBin (J.Asr, cx, cy));
register_un_prim "%int_neg" `Pure
- (fun cx -> J.EUn (J.Neg, cx));
+ (fun cx -> to_int (J.EUn (J.Neg, cx)));
register_bin_prim "caml_eq_float" `Pure
(fun cx cy -> bool (J.EBin (J.EqEq, float_val cx, float_val cy)));
register_bin_prim "caml_neq_float" `Pure
@@ -607,9 +791,7 @@
register_un_prim "caml_js_from_string" `Mutable
(fun cx -> J.ECall (J.EDot (cx, "toString"), []));
register_un_prim "caml_js_to_string" `Mutable
- (fun cx ->
- Primitive.mark_used "MlString";
- J.ENew (J.EVar "MlWrappedString", Some [cx]));
+ (fun cx -> J.ENew (s_var "MlWrappedString", Some [cx]));
register_tern_prim "caml_js_set"
(fun cx cy cz -> J.EBin (J.Eq, J.EAccess (cx, cy), cz));
register_bin_prim "caml_js_get" `Mutable
@@ -627,49 +809,81 @@
let varset_disjoint s s' = not (VarSet.exists (fun x -> VarSet.mem x s') s)
+let is_ident =
+ let l = Array.init 256 (fun i ->
+ let c = Char.chr i in
+ if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$'
+ then 1
+ else if (c >= '0' && c <='9')
+ then 2
+ else 0
+ ) in
+ fun s ->
+ try
+ for i = 0 to String.length s - 1 do
+ let code = l.(Char.code(s.[i])) in
+ if i = 0 then assert (code = 1) else assert (code >= 1)
+ done;
+ true
+ with _ -> false
+
+let ident_from_string s =
+ match Util.split_char '.' s with
+ | [] -> assert false
+ | [x] ->
+ if not (is_ident x)
+ then Format.eprintf "Warning: %S is not a valid identifier; the generated code might be incorrect.@." x;
+ s_var x
+ | (x::xs) as l ->
+ Format.eprintf "Warning: %S should be written (Js.Unsafe.variable %S)##%s@." s x (String.concat "##" xs);
+ if not (List.for_all is_ident l)
+ then Format.eprintf "Warning: %S is not a valid identifier; the generated code might be incorrect.@." s;
+ List.fold_left (fun e i -> J.EDot(e,i)) (s_var x) xs
+
let rec group_closures_rec closures req =
match closures with
[] ->
([], VarSet.empty)
- | ((var, vars, _) as elt) :: rem ->
- let req = VarSet.union vars req in
+ | ((var, vars, req_tc, clo) as elt) :: rem ->
+ let req = VarSet.union vars req in
+ let req = VarSet.union req req_tc in
let (closures', prov) = group_closures_rec rem req in
- if varset_disjoint prov req then
+ match closures' with
+ | [] ->
([elt] :: closures', VarSet.singleton var)
- else
- match closures' with
- [] -> assert false
- | l :: r -> ((elt :: l) :: r, VarSet.add var prov)
+ | _ when varset_disjoint prov req ->
+ ([elt] :: closures', VarSet.singleton var)
+ | l :: r -> ((elt :: l) :: r, VarSet.add var prov)
let group_closures l = fst (group_closures_rec l VarSet.empty)
let rec collect_closures ctx l =
match l with
Let (x, Closure (args, ((pc, _) as cont))) :: rem ->
+ let clo = compile_closure ctx cont in
+
let all_vars = AddrMap.find pc ctx.Ctx.mutated_vars in
+
+ let tc = (new Js_tailcall.tailcall) in
+ ignore(tc#sources clo);
+ let req_tc = (tc#get) in
+
let vars = VarSet.remove x all_vars in
- let fun_name =
- if not (VarSet.is_empty vars) && VarSet.mem x all_vars then
- Some (Var.to_string x)
- else
- None
- in
let cl =
- J.EFun ((fun_name, List.map Var.to_string args,
- compile_closure ctx cont), Some pc)
+ J.EFun (None, List.map (fun v -> J.V v) args, clo, J.Loc (DebugAddr.of_addr pc))
in
let (l', rem') = collect_closures ctx rem in
- ((x, vars, cl) :: l', rem')
+ ((x, vars, req_tc, cl) :: l', rem')
| _ ->
([], l)
(****)
-and translate_expr ctx queue x e =
+and translate_expr ctx queue x e level =
match e with
Const i ->
- (int i, const_p, queue)
- | Apply (x, l, Some n) when n = List.length l ->
+ (int32 i, const_p, queue),[]
+ | Apply (x, l, true) ->
let ((px, cx), queue) = access_queue queue x in
let (args, prop, queue) =
List.fold_right
@@ -678,18 +892,20 @@
access_queue queue x in (cx :: args, or_p prop prop', queue))
l ([], or_p px mutator_p, queue)
in
- (J.ECall (cx, args), prop, queue)
- | Apply (x, l, _) ->
+ (J.ECall (cx, args), prop, queue),[]
+ | Apply (x, l, false) ->
let (args, prop, queue) =
List.fold_right
(fun x (args, prop, queue) ->
let ((prop', cx), queue) =
access_queue queue x in (cx :: args, or_p prop prop', queue))
- (x :: l) ([], mutator_p, queue)
+ l ([], mutator_p, queue)
in
- let y = get_apply_fun (List.length l) in
- (J.ECall (J.EVar (Var.to_string y), args),
- prop, queue)
+ let ((prop', f), queue) = access_queue queue x in
+ let prop = or_p prop prop' in
+
+ let e = apply_fun ctx f args in
+ (e, prop, queue),[]
| Block (tag, a) ->
let (contents, prop, queue) =
List.fold_right
@@ -698,307 +914,321 @@
(Some cx :: args, or_p prop prop', queue))
(Array.to_list a) ([], const_p, queue)
in
- (J.EArr (Some (int tag) :: contents), prop, queue)
+ (J.EArr (Some (int tag) :: contents), prop, queue),[]
| Field (x, n) ->
let ((px, cx), queue) = access_queue queue x in
- (J.EAccess (cx, int (n + 1)), or_p px mutable_p, queue)
- | Closure (args, ((pc, _) as cont)) ->
- (*FIX: should flush only the closure free variables...*)
- (*FIX: if there are several closures in a row, we should process them
- simultaneously (possibly recursive functions)*)
- let all_vars = AddrMap.find pc ctx.Ctx.mutated_vars in
- let vars =
- all_vars
- >> VarSet.remove x
- >> VarSet.elements
- >> List.map Var.to_string
- in
- let fun_name =
- if vars <> [] && VarSet.mem x all_vars then
- Some (Var.to_string x)
- else
- None
- in
- let cl =
- J.EFun ((fun_name, List.map Var.to_string args,
- compile_closure ctx cont), Some pc)
- in
- let cl =
- if vars = [] then cl else
- J.ECall (J.EFun ((None, vars,
- [J.Statement (J.Return_statement (Some cl))]),
- Some pc),
- List.map (fun x -> J.EVar x) vars)
- in
- (cl, flush_p, queue)
+ (J.EAccess (cx, int (n + 1)), or_p px mutable_p, queue),[]
+ | Closure _ ->
+ (* this is done by translate_instr *)
+ assert false
| Constant c ->
- (constant c, const_p, queue)
+ let js, instrs = constant ~ctx c level in
+ (js, const_p, queue), instrs
| Prim (p, l) ->
- begin match p, l with
- Vectlength, [Pv x] ->
- let ((px, cx), queue) = access_queue queue x in
- (J.EBin (J.Minus, J.EDot (cx, "length"), one), px, queue)
- | Array_get, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (J.EAccess (cx, J.EBin (J.Plus, cy, one)),
- or_p mutable_p (or_p px py), queue)
+ let res = match p, l with
+ Vectlength, [x] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ (J.EBin (J.Minus, J.EDot (cx, "length"), one), px, queue)
+ | Array_get, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (J.EAccess (cx, J.EBin (J.Plus, cy, one)),
+ or_p mutable_p (or_p px py), queue)
| Extern "caml_js_var", [Pc (String nm)] ->
- Code.add_reserved_name nm; (*XXX HACK *)
- (J.EVar nm, const_p, queue)
+ (ident_from_string nm, const_p, queue)
| Extern "caml_js_const", [Pc (String nm)] ->
- Code.add_reserved_name nm; (*XXX HACK *)
- (J.EVar nm, const_p, queue)
- | Extern "caml_js_opt_call", Pv f :: Pv o :: l ->
- let ((pf, cf), queue) = access_queue queue f in
- let ((po, co), queue) = access_queue queue o in
- let (args, prop, queue) =
- List.fold_right
- (fun x (args, prop, queue) ->
- let x = match x with Pv x -> x | _ -> assert false in
- let ((prop', cx), queue) = access_queue queue x in
- (cx :: args, or_p prop prop', queue))
- l ([], mutator_p, queue)
- in
- (J.ECall (J.EDot (cf, "call"), co :: args),
- or_p (or_p pf po) prop, queue)
- | Extern "caml_js_opt_fun_call", Pv f :: l ->
- let ((pf, cf), queue) = access_queue queue f in
- let (args, prop, queue) =
- List.fold_right
- (fun x (args, prop, queue) ->
- let x = match x with Pv x -> x | _ -> assert false in
- let ((prop', cx), queue) = access_queue queue x in
- (cx :: args, or_p prop prop', queue))
- l ([], mutator_p, queue)
- in
- (J.ECall (cf, args), or_p pf prop, queue)
- | Extern "caml_js_opt_meth_call", Pv o :: Pc (String m) :: l ->
- let ((po, co), queue) = access_queue queue o in
- let (args, prop, queue) =
- List.fold_right
- (fun x (args, prop, queue) ->
- let x = match x with Pv x -> x | _ -> assert false in
- let ((prop', cx), queue) = access_queue queue x in
- (cx :: args, or_p prop prop', queue))
- l ([], mutator_p, queue)
- in
- (J.ECall (J.EDot (co, m), args), or_p po prop, queue)
- | Extern "caml_js_opt_new", Pv c :: l ->
- let ((pc, cc), queue) = access_queue queue c in
- let (args, prop, queue) =
- List.fold_right
- (fun x (args, prop, queue) ->
- let x = match x with Pv x -> x | _ -> assert false in
- let ((prop', cx), queue) = access_queue queue x in
- (cx :: args, or_p prop prop', queue))
- l ([], mutator_p, queue)
- in
- (J.ENew (cc, if args = [] then None else Some args),
- or_p pc prop, queue)
+ (ident_from_string nm, const_p, queue)
+ | Extern "caml_js_expr", [Pc (String nm)] ->
+ begin
+ try
+ let lex = Parse_js.lexer_from_string nm in
+ let e = Parse_js.parse_expr lex in
+ (e, const_p, queue)
+ with Parse_js.Parsing_error pi ->
+ failwith (Printf.sprintf "Parsing error %S at l:%d col:%d" nm (pi.Parse_info.line + 1) pi.Parse_info.col)
+ end
+ | Extern "%caml_js_opt_call", Pv f :: Pv o :: l ->
+ let ((pf, cf), queue) = access_queue queue f in
+ let ((po, co), queue) = access_queue queue o in
+ let (args, prop, queue) =
+ List.fold_right
+ (fun x (args, prop, queue) ->
+ let ((prop', cx), queue) = access_queue' ~ctx queue x in
+ (cx :: args, or_p prop prop', queue)
+ )
+ l ([], mutator_p, queue)
+ in
+ (J.ECall (J.EDot (cf, "call"), co :: args),
+ or_p (or_p pf po) prop, queue)
+ | Extern "%caml_js_opt_fun_call", Pv f :: l ->
+ let ((pf, cf), queue) = access_queue queue f in
+ let (args, prop, queue) =
+ List.fold_right
+ (fun x (args, prop, queue) ->
+ let ((prop', cx), queue) = access_queue' ~ctx queue x in
+ (cx :: args, or_p prop prop', queue))
+ l ([], mutator_p, queue)
+ in
+ (J.ECall (cf, args), or_p pf prop, queue)
+ | Extern "%caml_js_opt_meth_call", Pv o :: Pc (String m) :: l ->
+ let ((po, co), queue) = access_queue queue o in
+ let (args, prop, queue) =
+ List.fold_right
+ (fun x (args, prop, queue) ->
+ let ((prop', cx), queue) = access_queue' ~ctx queue x in
+ (cx :: args, or_p prop prop', queue))
+ l ([], mutator_p, queue)
+ in
+ (J.ECall (J.EDot (co, m), args), or_p po prop, queue)
+ | Extern "%caml_js_opt_new", Pv c :: l ->
+ let ((pc, cc), queue) = access_queue queue c in
+ let (args, prop, queue) =
+ List.fold_right
+ (fun x (args, prop, queue) ->
+ let ((prop', cx), queue) = access_queue' ~ctx queue x in
+ (cx :: args, or_p prop prop', queue))
+ l ([], mutator_p, queue)
+ in
+ (J.ENew (cc, if args = [] then None else Some args),
+ or_p pc prop, queue)
| Extern "caml_js_get", [Pv o; Pc (String f)] ->
- let ((po, co), queue) = access_queue queue o in
- (J.EDot (co, f), or_p po mutable_p, queue)
+ let ((po, co), queue) = access_queue queue o in
+ (J.EDot (co, f), or_p po mutable_p, queue)
| Extern "caml_js_set", [Pv o; Pc (String f); Pv v] ->
- let ((po, co), queue) = access_queue queue o in
- let ((pv, cv), queue) = access_queue queue v in
- (J.EBin (J.Eq, J.EDot (co, f), cv),
- or_p (or_p po pv) mutator_p, queue)
+ let ((po, co), queue) = access_queue queue o in
+ let ((pv, cv), queue) = access_queue queue v in
+ (J.EBin (J.Eq, J.EDot (co, f), cv),
+ or_p (or_p po pv) mutator_p, queue)
| Extern "caml_js_delete", [Pv o; Pc (String f)] ->
- let ((po, co), queue) = access_queue queue o in
- (J.EUn(J.Delete, J.EDot (co, f)), or_p po mutator_p, queue)
- | Extern "%object_literal", fields ->
- let rec build_fields l =
- match l with
- [] ->
- []
- | Pc (String nm) :: Pc (String v) :: r ->
- (J.PNS nm, J.EStr (v, `Bytes)) :: build_fields r
- | _ ->
- assert false
- in
- (J.EObj (build_fields fields), const_p, queue)
- | Extern "caml_js_opt_object", fields ->
- let rec build_fields queue l =
- match l with
+ let ((po, co), queue) = access_queue queue o in
+ (J.EUn(J.Delete, J.EDot (co, f)), or_p po mutator_p, queue)
+ | Extern "%overrideMod", [Pc (String m);Pc (String f)] ->
+ s_var (Printf.sprintf "caml_%s_%s" m f), const_p,queue
+ | Extern "%overrideMod", _ ->
+ assert false
+ | Extern "%caml_js_opt_object", fields ->
+ let rec build_fields queue l =
+ match l with
[] ->
- (const_p, [], queue)
- | Pc (String nm) :: Pv x :: r ->
- let ((prop, cx), queue) = access_queue queue x in
- let (prop', r', queue') = build_fields queue r in
- (or_p prop prop', (J.PNS nm, cx) :: r', queue)
+ (const_p, [], queue)
+ | Pc (String nm) :: x :: r ->
+ let ((prop, cx), queue) = access_queue' ~ctx queue x in
+ let (prop', r', queue') = build_fields queue r in
+ (or_p prop prop', (J.PNS nm, cx) :: r', queue)
| _ ->
- assert false
- in
- let (prop, fields, queue) = build_fields queue fields in
- (J.EObj fields, prop, queue)
+ assert false
+ in
+ let (prop, fields, queue) = build_fields queue fields in
+ (J.EObj fields, prop, queue)
| Extern name, l ->
+ begin
let name = Primitive.resolve name in
- begin match internal_prim name with
- Some f ->
- f l queue
- | None ->
- Primitive.mark_used name;
- Code.add_reserved_name name; (*XXX HACK *)
- (* FIX: this is done at the wrong time... *)
+ match internal_prim name with
+ | Some f -> f l queue ctx
+ | None ->
+ if name.[0] = '%'
+ then failwith (Printf.sprintf "Unresolved interal primitive: %s" name);
+ let prim = Share.get_prim s_var name ctx.Ctx.share in
let prim_kind = kind (Primitive.kind name) in
let (args, prop, queue) =
List.fold_right
(fun x (args, prop, queue) ->
- let x = match x with Pv x -> x | _ -> assert false in
- let ((prop', cx), queue) = access_queue queue x in
+ let ((prop', cx), queue) = access_queue' ~ctx queue x in
(cx :: args, or_p prop prop', queue))
l ([], prim_kind, queue)
in
- (J.ECall (J.EVar name, args), prop, queue)
- end
- | Not, [Pv x] ->
- let ((px, cx), queue) = access_queue queue x in
- (J.EBin (J.Minus, one, cx), px, queue)
- | Lt, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (bool (J.EBin (J.Lt, cx, cy)), or_p px py, queue)
- | Le, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (bool (J.EBin (J.Le, cx, cy)), or_p px py, queue)
- | Eq, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (bool (J.EBin (J.EqEqEq, cx, cy)), or_p px py, queue)
- | Neq, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (bool (J.EBin (J.NotEqEq, cx, cy)), or_p px py, queue)
- | IsInt, [Pv x] ->
- let ((px, cx), queue) = access_queue queue x in
- (J.EBin(J.EqEqEq, J.EUn (J.Typeof, cx), J.EStr ("number", `Bytes)),
- px, queue)
-(*
- (boolnot (J.EBin(J.InstanceOf, cx, J.EVar ("Array"))), px, queue)
-*)
- | Ult, [Pv x; Pv y] ->
- let ((px, cx), queue) = access_queue queue x in
- let ((py, cy), queue) = access_queue queue y in
- (bool (J.EBin (J.Or, J.EBin (J.Lt, cy, int 0),
- J.EBin (J.Lt, cx, cy))),
- or_p px py, queue)
- | WrapInt, [Pv x] ->
- let ((px, cx), queue) = access_queue queue x in
- (to_int cx, px, queue)
+ (J.ECall (prim, args), prop, queue)
+ end
+ | Not, [x] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ (J.EBin (J.Minus, one, cx), px, queue)
+ | Lt, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (bool (J.EBin (J.Lt, cx, cy)), or_p px py, queue)
+ | Le, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (bool (J.EBin (J.Le, cx, cy)), or_p px py, queue)
+ | Eq, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (bool (J.EBin (J.EqEqEq, cx, cy)), or_p px py, queue)
+ | Neq, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (bool (J.EBin (J.NotEqEq, cx, cy)), or_p px py, queue)
+ | IsInt, [x] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ (J.EBin(J.EqEqEq, J.EUn (J.Typeof, cx), (Share.get_string str_js "number" ctx.Ctx.share)),
+ px, queue)
+ | Ult, [x; y] ->
+ let ((px, cx), queue) = access_queue' ~ctx queue x in
+ let ((py, cy), queue) = access_queue' ~ctx queue y in
+ (bool (J.EBin (J.Or, J.EBin (J.Lt, cy, int 0),
+ J.EBin (J.Lt, cx, cy))),
+ or_p px py, queue)
| (Vectlength | Array_get | Not | IsInt | Eq |
- Neq | Lt | Le | Ult | WrapInt), _ ->
- assert false
- end
+ Neq | Lt | Le | Ult), _ ->
+ assert false
+ in res,[]
-and translate_closures ctx expr_queue l =
+and translate_closures ctx expr_queue l pc =
match l with
[] ->
([], expr_queue)
- | [(x, vars, cl)] :: rem ->
+ | [(x, vars, req_tc, cl)] :: rem ->
let vars =
vars
>> VarSet.elements
- >> List.map Var.to_string
+ >> List.map (fun v -> J.V v)
in
- let cl =
- if vars = [] then cl else
- J.ECall (J.EFun ((None, vars,
- [J.Statement (J.Return_statement (Some cl))]),
- None),
- List.map (fun x -> J.EVar x) vars)
+ let prim name = Share.get_prim s_var name ctx.Ctx.share in
+ let defs =
+ Js_tailcall.rewrite [x,cl,J.Loc (DebugAddr.of_addr pc),req_tc] prim in
+ let rec return_last x = function
+ | [] -> [J.Statement (J.Return_statement (Some (J.EVar (J.V x)),J.N))]
+ | [J.Variable_statement l as sts] ->
+ let l' = List.rev l in
+ begin match l' with
+ | (J.V x',Some (e,pc)) :: rem when x = x' ->
+ [J.Statement (J.Variable_statement (List.rev rem));
+ J.Statement (J.Return_statement (Some e,pc))]
+ | _ -> [J.Statement sts]
+ end
+ | y::xs -> J.Statement (y) :: return_last x xs
in
+ let statements =
+ if vars = [] then defs else
+ [J.Variable_statement [
+ J.V x,
+ Some (
+ J.ECall (J.EFun (None, vars, return_last x defs, J.N),
+ List.map (fun x -> J.EVar x) vars), J.N)]]
+ in
+
let (st, expr_queue) =
- match ctx.Ctx.live.(Var.idx x) with
- 0 -> flush_queue expr_queue flush_p [J.Expression_statement (cl, None)]
- | 1 -> enqueue expr_queue flush_p x cl
- | _ -> flush_queue expr_queue flush_p
- [J.Variable_statement [Var.to_string x, Some cl]]
+ match ctx.Ctx.live.(Var.idx x),statements with
+ | 0, _ -> assert false
+ | 1, [J.Variable_statement [(J.V x',Some (e', _))]] when x == x' ->
+ enqueue expr_queue flush_p x e' pc 1 []
+ | _ -> flush_queue expr_queue flush_p statements
in
- let (st', expr_queue) = translate_closures ctx expr_queue rem in
+ let (st', expr_queue) = translate_closures ctx expr_queue rem pc in
(st @ st', expr_queue)
| l :: rem ->
let names =
- List.fold_left (fun s (x, _, _) -> VarSet.add x s) VarSet.empty l in
+ List.fold_left (fun s (x, _, _, _) -> VarSet.add x s) VarSet.empty l in
let vars =
- List.fold_left (fun s (_, s', _) -> VarSet.union s s') VarSet.empty l
+ List.fold_left (fun s (_, s', _, _) -> VarSet.union s s') VarSet.empty l
in
let vars =
VarSet.diff vars names
>> VarSet.elements
- >> List.map Var.to_string
+ >> List.map (fun v -> J.V v)
in
- let defs =
- List.map (fun (x, _, cl) -> (Var.to_string x, Some cl)) l in
- let statement =
- if vars = [] then
- J.Variable_statement defs
+ let defs' =
+ List.map
+ (fun (x, _, req_tc, cl) -> x,cl,J.Loc (DebugAddr.of_addr pc),req_tc)
+ l
+ in
+ let prim name = Share.get_prim s_var name ctx.Ctx.share in
+ let defs = Js_tailcall.rewrite defs' prim in
+ let statements =
+ if vars = [] then defs
else begin
let tbl = Var.fresh () in
+ Var.name tbl "funenv";
let arr =
J.EArr
- (List.map (fun (x, _, _) -> Some (J.EVar (Var.to_string x))) l)
+ (List.map (fun (x, _, _, _) -> Some (J.EVar (J.V x))) l)
in
let assgn =
List.fold_left
- (fun (l, n) (x, _, _) ->
- ((Var.to_string x,
- Some (J.EAccess (J.EVar (Var.to_string tbl), int n))) :: l,
+ (fun (l, n) (x, _, _, _) ->
+ ((J.V x,
+ Some (J.EAccess (J.EVar (J.V tbl), int n),
+ J.Loc (DebugAddr.of_addr pc))) :: l,
n + 1))
([], 0) l
in
- J.Variable_statement
- ((Var.to_string tbl,
+ [J.Variable_statement
+ ((J.V tbl,
Some
(J.ECall
- (J.EFun ((None, vars,
- [J.Statement (J.Variable_statement defs);
- J.Statement (J.Return_statement (Some arr))]),
- None),
- List.map (fun x -> J.EVar x) vars))) ::
- List.rev (fst assgn))
+ (J.EFun (None, vars,
+ List.map (fun s -> J.Statement s) defs
+ @ [J.Statement (J.Return_statement (Some arr,J.N))],
+ J.N),
+ List.map (fun x -> J.EVar x) vars), J.N)) ::
+ List.rev (fst assgn))]
end
in
- let (st, expr_queue) = flush_queue expr_queue flush_p [statement] in
- let (st', expr_queue) = translate_closures ctx expr_queue rem in
+ let (st, expr_queue) = flush_queue expr_queue flush_p statements in
+ let (st', expr_queue) = translate_closures ctx expr_queue rem pc in
(st @ st', expr_queue)
-and translate_instr ctx expr_queue pc instr =
+and translate_instr ctx expr_queue (pc : addr) instr =
match instr with
[] ->
([], expr_queue)
+ | Let (_, Prim (Extern "debugger",_))::rem ->
+ let ins =
+ if Option.Optim.debugger ()
+ then J.Debugger_statement J.N
+ else J.Empty_statement J.N in
+ let st = flush_all expr_queue [ins] in
+ let (instrs, expr_queue) = translate_instr ctx [] pc rem in
+ (st @ instrs, expr_queue)
| Let (_, Closure _) :: _ ->
let (l, rem) = collect_closures ctx instr in
let l = group_closures l in
- let (st, expr_queue) = translate_closures ctx expr_queue l in
+ let (st, expr_queue) = translate_closures ctx expr_queue l pc in
let (instrs, expr_queue) = translate_instr ctx expr_queue pc rem in
(st @ instrs, expr_queue)
| i :: rem ->
let (st, expr_queue) =
match i with
Let (x, e) ->
- let (ce, prop, expr_queue) = translate_expr ctx expr_queue x e in
- begin match ctx.Ctx.live.(Var.idx x) with
- 0 -> flush_queue expr_queue prop [J.Expression_statement
- (ce, Some pc)]
- | 1 -> enqueue expr_queue prop x ce
+ let (ce, prop, expr_queue),instrs = translate_expr ctx expr_queue x e 0 in
+ begin match ctx.Ctx.live.(Var.idx x),e with
+ | 0,_ -> flush_queue expr_queue prop (instrs@[J.Expression_statement
+ (ce, J.Loc (DebugAddr.of_addr pc))])
+ | 1,_ -> enqueue expr_queue prop x ce pc 1 instrs
+ (* We could inline more.
+ size_v : length of the variable after serialization
+ size_c : length of the constant after serialization
+ num : number of occurence
+ size_c * n < size_v * n + size_v + 1 + size_c
+ *)
+ | n,(Const _| Constant (Int _|Float _)) ->
+ enqueue expr_queue prop x ce pc n instrs
| _ -> flush_queue expr_queue prop
- [J.Variable_statement [Var.to_string x, Some ce]]
+ (instrs@
+ [J.Variable_statement
+ [J.V x,
+ Some (ce, J.Loc (DebugAddr.of_addr pc))]])
end
| Set_field (x, n, y) ->
let ((px, cx), expr_queue) = access_queue expr_queue x in
let ((py, cy), expr_queue) = access_queue expr_queue y in
flush_queue expr_queue mutator_p
[J.Expression_statement
- ((J.EBin (J.Eq, J.EAccess (cx, int (n + 1)), cy)), Some pc)]
+ ((J.EBin (J.Eq, J.EAccess (cx, int (n + 1)), cy)), J.Loc (DebugAddr.of_addr pc))]
+ | Offset_ref (x, 1) ->
+ (* FIX: may overflow.. *)
+ let ((px, cx), expr_queue) = access_queue expr_queue x in
+ flush_queue expr_queue mutator_p
+ [J.Expression_statement
+ ((J.EUn (J.IncrA, (J.EAccess (cx, J.ENum 1.)))),
+ J.Loc (DebugAddr.of_addr pc))]
| Offset_ref (x, n) ->
-(* FIX: may overflow.. *)
+ (* FIX: may overflow.. *)
let ((px, cx), expr_queue) = access_queue expr_queue x in
flush_queue expr_queue mutator_p
[J.Expression_statement
((J.EBin (J.PlusEq, (J.EAccess (cx, J.ENum 1.)), int n)),
- Some pc)]
+ J.Loc (DebugAddr.of_addr pc))]
| Array_set (x, y, z) ->
let ((px, cx), expr_queue) = access_queue expr_queue x in
let ((py, cy), expr_queue) = access_queue expr_queue y in
@@ -1007,23 +1237,15 @@
[J.Expression_statement
((J.EBin (J.Eq, J.EAccess (cx, J.EBin(J.Plus, cy, one)),
cz)),
- Some pc)]
+ J.Loc (DebugAddr.of_addr pc))]
in
let (instrs, expr_queue) = translate_instr ctx expr_queue pc rem in
(st @ instrs, expr_queue)
-and compile_block st queue pc frontier interm =
+and compile_block st queue (pc : addr) frontier interm =
if queue <> [] && AddrSet.mem pc st.loops then
flush_all queue (compile_block st [] pc frontier interm)
else begin
-(*
-Format.eprintf "(frontier: ";
-AddrSet.iter (fun pc -> Format.eprintf "%d " pc) frontier;
-Format.eprintf ")@.";
-Format.eprintf "(interm: ";
-AddrMap.iter (fun pc (pc', _) -> Format.eprintf " %d->%d " pc pc') interm;
-Format.eprintf ")@.";
-*)
if pc >= 0 then begin
if AddrSet.mem pc st.visited_blocks then begin
Format.eprintf "!!!! %d@." pc; assert false
@@ -1036,7 +1258,7 @@
end;
if AddrSet.mem pc st.loops then begin
let lab =
- match st.loop_stack with (_, (l, _)) :: _ -> l + 1 | [] -> 0 in
+ match st.loop_stack with (_, (l, _)) :: _ -> J.Label.succ l | [] -> J.Label.zero in
st.loop_stack <- (pc, (lab, ref false)) :: st.loop_stack
end;
let succs = Hashtbl.find st.succs pc in
@@ -1050,11 +1272,6 @@
succs AddrSet.empty
in
let new_frontier = resolve_nodes interm grey in
-(*
-Format.eprintf "<<%d:" pc;
-AddrSet.iter (fun pc -> Format.eprintf " %d" pc) frontier;
-Format.eprintf ">>@ ";
-*)
let block = AddrMap.find pc st.blocks in
let (seq, queue) = translate_instr st.ctx queue pc block.body in
let body =
@@ -1074,15 +1291,22 @@
if limit_body then incr_preds st pc3;
assert (AddrSet.cardinal inner_frontier <= 1);
if debug () then Format.eprintf "@[<2>try {@,";
-(*
-Format.eprintf "===== %d ===== (%b)@." pc3 limit_body;
-*)
let body =
compile_branch st [] (pc1, args1)
None AddrSet.empty inner_frontier interm
in
if debug () then Format.eprintf "} catch {@,";
let handler = compile_block st [] pc2 inner_frontier interm in
+ let handler =
+ if st.ctx.Ctx.live.(Var.idx x) > 0 && Option.Optim.excwrap ()
+ then J.Expression_statement (
+ J.EBin(
+ J.Eq,
+ J.EVar (J.V x),
+ J.ECall (Share.get_prim s_var "caml_wrap_exception" st.ctx.Ctx.share,
+ [J.EVar (J.V x)])),J.N)
+ ::handler
+ else handler in
let x =
let block2 = AddrMap.find pc2 st.blocks in
let m = Subst.build_mapping args2 block2.params in
@@ -1091,25 +1315,17 @@
if debug () then Format.eprintf "}@]@ ";
if limit_body then decr_preds st pc3;
flush_all queue
- (J.Try_statement (Js_simpl.statement_list body,
- Some (Var.to_string x,
- Js_simpl.statement_list handler),
+ (J.Try_statement (body,
+ Some (J.V x,
+ handler),
None,
- Some pc) ::
+ J.Loc (DebugAddr.of_addr pc)) ::
if AddrSet.is_empty inner_frontier then [] else begin
let pc = AddrSet.choose inner_frontier in
-(*
-Format.eprintf ">>Frontier: ";
-AddrSet.iter (fun pc -> Format.eprintf "%d " pc) frontier;
-Format.eprintf "@.";
-*)
if AddrSet.mem pc frontier then [] else
compile_block st [] pc frontier interm
end)
| _ ->
-(*
-Format.eprintf "[[@.";
-*)
let (new_frontier, new_interm) =
if AddrSet.cardinal new_frontier > 1 then begin
let x = Code.Var.fresh () in
@@ -1117,11 +1333,6 @@
if debug () then Format.eprintf "@ var %a;" Code.Var.print x;
let idx = st.interm_idx in
st.interm_idx <- idx - 1;
-(*
-Format.eprintf "%d ====> " idx;
-AddrSet.iter (fun pc -> Format.eprintf "%d " pc) new_frontier;
-Format.eprintf "@.";
-*)
let cases = Array.map (fun pc -> (pc, [])) a in
let switch =
if Array.length cases > 2 then
@@ -1156,59 +1367,47 @@
compile_conditional
st queue pc block.branch block.handler
backs new_frontier new_interm succs in
-(*
-let res =
-*)
cond @
if AddrSet.cardinal new_frontier = 0 then [] else begin
let pc = AddrSet.choose new_frontier in
if AddrSet.mem pc frontier then [] else
compile_block st [] pc frontier interm
end
-(*
-in
-Format.eprintf "]]@.";
-res
-*)
in
if AddrSet.mem pc st.loops then begin
let label =
match st.loop_stack with
- (_, (l, used)) :: r -> st.loop_stack <- r; if !used then l else -1
+ (_, (l, used)) :: r -> st.loop_stack <- r; if !used then Some l else None
| [] -> assert false
in
let st =
J.For_statement
- (None, None, None,
- Js_simpl.block
+ (J.Left None, None, None,
+ J.Block(
(if AddrSet.cardinal frontier > 0 then begin
if debug () then
Format.eprintf "@ break (%d); }@]"
(AddrSet.choose new_frontier);
- body @ [J.Break_statement None]
+ body @ [J.Break_statement (None,J.N)]
end else begin
if debug () then Format.eprintf "}@]";
body
- end),
- Some pc)
+ end),J.N),
+ J.Loc (DebugAddr.of_addr pc))
in
- if label = -1 then
- [st]
- else
- [J.Labelled_statement (Code.string_of_ident label, st)]
+ match label with
+ | None -> [st]
+ | Some label -> [J.Labelled_statement (label, st, J.N)]
end else
body
end
-and compile_if st e cont1 cont2 handler backs frontier interm succs =
+and compile_if st e ?pc cont1 cont2 handler backs frontier interm succs =
let iftrue = compile_branch st [] cont1 handler backs frontier interm in
let iffalse = compile_branch st [] cont2 handler backs frontier interm in
-(*
-Format.eprintf "====@.";
-*)
- Js_simpl.if_statement e
- (Js_simpl.block iftrue) (never_continue st cont1 frontier interm succs)
- (Js_simpl.block iffalse) (never_continue st cont2 frontier interm succs)
+ Js_simpl.if_statement e ?pc
+ (J.Block (iftrue,J.N)) (never_continue st cont1 frontier interm succs)
+ (J.Block (iffalse,J.N)) (never_continue st cont2 frontier interm succs)
and compile_conditional st queue pc last handler backs frontier interm succs =
List.iter
@@ -1222,16 +1421,17 @@
| Cond _ -> Format.eprintf "@[cond{@,"
| Switch _ -> Format.eprintf "@[switch{@,"
end;
+ let loc = J.Loc (DebugAddr.of_addr pc) in
let res =
match last with
Return x ->
let ((px, cx), queue) = access_queue queue x in
- flush_all queue [J.Return_statement (Some cx)]
+ flush_all queue [J.Return_statement (Some cx,loc)]
| Raise x ->
let ((px, cx), queue) = access_queue queue x in
- flush_all queue [J.Throw_statement cx]
+ flush_all queue [J.Throw_statement (cx,loc)]
| Stop ->
- flush_all queue [J.Return_statement None]
+ flush_all queue [J.Return_statement (None,loc)]
| Branch cont ->
compile_branch st queue cont handler backs frontier interm
| Cond (c, x, cont1, cont2) ->
@@ -1239,16 +1439,16 @@
let e =
match c with
IsTrue -> cx
- | CEq n -> J.EBin (J.EqEqEq, int n, cx)
- | CLt n -> J.EBin (J.Lt, int n, cx)
+ | CEq n -> J.EBin (J.EqEqEq, int32 n, cx)
+ | CLt n -> J.EBin (J.Lt, int32 n, cx)
| CUlt n -> J.EBin (J.Or, J.EBin (J.Lt, cx, int 0),
- J.EBin (J.Lt, int n, cx))
- | CLe n -> J.EBin (J.Le, int n, cx)
+ J.EBin (J.Lt, int32 n, cx))
+ | CLe n -> J.EBin (J.Le, int32 n, cx)
in
(* Some changes here may require corresponding changes
in function [fold_children] above. *)
flush_all queue
- (compile_if st e cont1 cont2 handler backs frontier interm succs)
+ (compile_if st e ~pc:loc cont1 cont2 handler backs frontier interm succs)
| Switch (x, a1, a2) ->
(* Some changes here may require corresponding changes
@@ -1266,11 +1466,11 @@
[] ->
assert false
| [(cont, _)] ->
- Js_simpl.block
- (compile_branch st [] cont handler backs frontier interm)
+ J.Block
+ (compile_branch st [] cont handler backs frontier interm,J.N)
| [cont1, [(n, _)]; cont2, _] | [cont2, _; cont1, [(n, _)]] ->
- Js_simpl.block (compile_if st (J.EBin (J.EqEqEq, int n, e))
- cont1 cont2 handler backs frontier interm succs)
+ J.Block (compile_if st (J.EBin (J.EqEqEq, int n, e))
+ cont1 cont2 handler backs frontier interm succs, J.N)
| (cont, l') :: rem ->
let l =
List.flatten
@@ -1282,25 +1482,23 @@
| (i, _) :: r ->
List.rev
((J.ENum (float i),
- Js_simpl.statement_list
- (compile_branch
- st [] cont handler backs frontier interm @
- if
- never_continue st cont frontier interm succs
- then
- []
- else
- [J.Break_statement None]))
- ::
+ (compile_branch
+ st [] cont handler backs frontier interm @
+ if
+ never_continue st cont frontier interm succs
+ then
+ []
+ else
+ [J.Break_statement (None, J.N)]))
+ ::
List.map
(fun (i, _) -> (J.ENum (float i), [])) r))
rem)
in
J.Switch_statement
(e, l,
- Some (Js_simpl.statement_list
- (compile_branch
- st [] cont handler backs frontier interm)))
+ Some (compile_branch
+ st [] cont handler backs frontier interm), loc)
in
let (st, queue) =
if Array.length a1 = 0 then
@@ -1314,7 +1512,8 @@
so we can directly refer to it *)
(Js_simpl.if_statement
(J.EBin(J.EqEqEq, J.EUn (J.Typeof, var x),
- J.EStr ("number", `Bytes)))
+ (Share.get_string str_js "number" st.ctx.Ctx.share)))
+ ~pc:loc
(build_switch (var x) a1)
false
(build_switch (J.EAccess(var x, J.ENum 0.)) a2)
@@ -1337,20 +1536,9 @@
and compile_argument_passing ctx queue (pc, args) backs continuation =
if args = [] then
continuation queue
- else begin
+ else
let block = AddrMap.find pc ctx.Ctx.blocks in
- (* We flush on backward edged. We do not need to flush on forward
- edges, as the block parameter variables are fresh. *)
- (*FIX: this is overly aggressive: we should instead keep track of
- dependencies between queued variables and take this into account
- to perform parallel renaming. *)
- let cont queue =
- parallel_renaming ctx block.params args continuation queue in
- if AddrSet.mem pc backs then
- flush_all queue (cont [])
- else
- cont queue
- end
+ parallel_renaming ctx block.params args continuation queue
and compile_exn_handling ctx queue (pc, args) handler continuation =
if pc < 0 then
@@ -1380,7 +1568,6 @@
[], [] ->
continuation queue
| x :: args, y :: params ->
-(*Format.eprintf "ZZZ@.";*)
let (z, old) =
match old with [] -> (None, []) | z :: old -> (Some z, old)
in
@@ -1390,24 +1577,22 @@
loop continuation old args params queue
else begin
let ((px, cx), queue) = access_queue queue x in
-(*Format.eprintf "%a := %a@." Var.print y Var.print x;*)
let (st, queue) =
(*FIX: we should flush only the variables we need rather than doing this;
do the same for closure free variables *)
match 2 (*ctx.Ctx.live.(Var.idx y)*) with
0 -> assert false
- | 1 -> enqueue queue px y cx
+ | 1 -> enqueue queue px y cx pc 1 []
| _ -> flush_queue queue px
- [J.Variable_statement [Var.to_string y, Some cx]]
+ [J.Variable_statement
+ [J.V y,
+ Some (cx, J.Loc (DebugAddr.of_addr pc))]]
in
st @ loop continuation old args params queue
end
| _ ->
assert false
in
-(*
-Format.eprintf "%d ==> %d/%d/%d@." pc (List.length h_args) (List.length h_block.params) (List.length old_args);
-*)
loop continuation old_args h_args h_block.params queue
and compile_branch st queue ((pc, _) as cont) handler backs frontier interm =
@@ -1424,7 +1609,7 @@
else begin
let (lab, used) = List.assoc pc rem in
used := true;
- Some (Code.string_of_ident lab)
+ Some lab
end
in
if debug () then begin
@@ -1433,7 +1618,7 @@
else
Format.eprintf "continue (%d);@ " pc
end;
- flush_all queue [J.Continue_statement label]
+ flush_all queue [J.Continue_statement (label,J.Loc (DebugAddr.of_addr pc))]
end else if AddrSet.mem pc frontier || AddrMap.mem pc interm then begin
if debug () then Format.eprintf "(br %d)@ " pc;
flush_all queue (compile_branch_selection pc interm)
@@ -1444,7 +1629,7 @@
try
let (pc, (x, i)) = AddrMap.find pc interm in
if debug () then Format.eprintf "@ %a=%d;" Code.Var.print x i;
- J.Variable_statement [Var.to_string x, Some (int i)] ::
+ J.Variable_statement [J.V x, Some (int i, J.Loc (DebugAddr.of_addr pc))] ::
compile_branch_selection pc interm
with Not_found ->
[]
@@ -1470,45 +1655,38 @@
Format.eprintf "Some blocks not compiled!@."; assert false
end;
if debug () then Format.eprintf "}@]@ ";
- Js_simpl.source_elements res
+ List.map (fun st -> J.Statement st ) res
-let compile_program standalone ctx pc =
+
+let generate_shared_value ctx =
+ let strings =
+ J.Statement (
+ J.Variable_statement (
+ List.map (fun (s,v) -> v, Some (str_js s,J.N)) (StringMap.bindings ctx.Ctx.share.Share.vars.Share.strings)
+ @ List.map (fun (s,v) -> v, Some (s_var s,J.N)) (StringMap.bindings ctx.Ctx.share.Share.vars.Share.prims)))
+ in
+
+ if not (Option.Optim.inline_callgen ())
+ then
+ let applies = List.map (fun (n,v) ->
+ match generate_apply_fun n with
+ | J.EFun (_,param,body,nid) ->
+ J.Function_declaration (v,param,body,nid)
+ | _ -> assert false) (IntMap.bindings ctx.Ctx.share.Share.vars.Share.applies) in
+ strings::applies
+ else [strings]
+
+let compile_program ctx pc =
let res = compile_closure ctx (pc, []) in
+ let res = generate_shared_value ctx @ res in
if debug () then Format.eprintf "@.@.";
-(*
- Primitive.list_used ();
-*)
- if standalone then
- let f = J.EFun ((None, [], generate_apply_funs res), None) in
- [J.Statement (J.Expression_statement ((J.ECall (f, [])), Some pc))]
- else
- let f = J.EFun ((None, [Var.to_string (Var.fresh ())],
- generate_apply_funs res), None) in
- [J.Statement (J.Expression_statement (f, Some pc))]
-
-(**********************)
-
-let list_missing l =
- if l <> [] then begin
- Format.eprintf "Missing primitives:@.";
- List.iter (fun nm -> Format.eprintf " %s@." nm) l
- end
+ res
-let f ch ?(standalone=true) ?linkall ((pc, blocks, _) as p) dl live_vars =
+let f ((pc, blocks, _) as p) live_vars =
let mutated_vars = Freevars.f p in
let t' = Util.Timer.make () in
- let ctx = Ctx.initial blocks live_vars mutated_vars in
- let p = compile_program standalone ctx pc in
- if !compact then Pretty_print.set_compact ch true;
- if standalone then begin
- Pretty_print.string ch
- "// This program was compiled from OCaml by js_of_ocaml 1.4";
- Pretty_print.newline ch;
- let missing = Linker.resolve_deps ?linkall !compact ch (Primitive.get_used ()) in
- list_missing missing
- end;
- Hashtbl.clear add_names;
- let res = Js_output.program ch p dl in
+ let share = Share.get p in
+ let ctx = Ctx.initial blocks live_vars mutated_vars share in
+ let p = compile_program ctx pc in
if times () then Format.eprintf " code gen.: %a@." Util.Timer.print t';
- res
-
+ p
diff -Nru js-of-ocaml-1.4/compiler/generate.mli js-of-ocaml-2.2/compiler/generate.mli
--- js-of-ocaml-1.4/compiler/generate.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/generate.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,7 +18,4 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-val set_pretty : unit -> unit
-
-val f : Pretty_print.t -> ?standalone:bool -> ?linkall:bool ->
- Code.program -> Parse_bytecode.debug_loc -> int array -> unit
+val f : Code.program -> int array -> Javascript.program
diff -Nru js-of-ocaml-1.4/compiler/inline.ml js-of-ocaml-2.2/compiler/inline.ml
--- js-of-ocaml-1.4/compiler/inline.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/inline.ml 2014-05-15 08:37:39.000000000 +0000
@@ -20,9 +20,6 @@
open Code
-let inline_disabled = Util.disabled "inline"
-(****)
-
let get_closures (_, blocks, _) =
AddrMap.fold
(fun _ block closures ->
@@ -43,9 +40,9 @@
assert (block.handler = None);
let block = { block with handler = handler } in
let block =
- match block.branch with
- Return y -> { block with branch = Branch (pc', [y]) }
- | _ -> block
+ match block.branch, pc' with
+ Return y, Some pc' -> { block with branch = Branch (pc', [y]) }
+ | _ -> block
in
AddrMap.add pc block blocks
@@ -101,19 +98,24 @@
List.fold_right
(fun i (rem, state) ->
match i with
- Let (x, Apply (f, args, Some n))
- when n = List.length args
- && live_vars.(Var.idx f) = 1
+ Let (x, Apply (f, args, true))
+ when live_vars.(Var.idx f) = 1
&& VarMap.mem f closures ->
let (params, (clos_pc, clos_args)) = VarMap.find f closures in
let (branch, blocks, free_pc) = state in
- let blocks =
- AddrMap.add free_pc
- { params = [x]; handler = block.handler;
- body = rem; branch = branch } blocks
+ let (blocks, cont_pc) =
+ match rem, branch with
+ [], Return y when Var.compare x y = 0 ->
+ (* We do not need a continuation block for tail calls *)
+ (blocks, None)
+ | _ ->
+ (AddrMap.add free_pc
+ { params = [x]; handler = block.handler;
+ body = rem; branch = branch } blocks,
+ Some free_pc)
in
let blocks =
- rewrite_closure blocks free_pc clos_pc block.handler in
+ rewrite_closure blocks cont_pc clos_pc block.handler in
(* We do not really need this intermediate block. It
just avoid the need to find which function parameters
are used in the function body. *)
@@ -123,6 +125,7 @@
body = []; branch = Branch (clos_pc, clos_args) } blocks
in
([], (Branch (free_pc + 1, args), blocks, free_pc + 2))
+
| _ ->
(i :: rem, state))
block.body ([], (block.branch, blocks, free_pc))
@@ -131,18 +134,12 @@
(****)
-(*FIX: this is unefficient, as we still perform the other
- optimizations phases repeatedly *)
-
let f ((pc, blocks, free_pc) as p) live_vars =
- if not (inline_disabled() || Deadcode.disabled ()) then begin
- let closures = get_closures p in
- let (blocks, free_pc) =
- AddrMap.fold
- (fun pc _ (blocks, free_pc) ->
- inline closures live_vars blocks free_pc pc)
- blocks (blocks, free_pc)
- in
- (pc, blocks, free_pc)
- end else
- p
+ let closures = get_closures p in
+ let (blocks, free_pc) =
+ AddrMap.fold
+ (fun pc _ (blocks, free_pc) ->
+ inline closures live_vars blocks free_pc pc)
+ blocks (blocks, free_pc)
+ in
+ (pc, blocks, free_pc)
diff -Nru js-of-ocaml-1.4/compiler/instr.ml js-of-ocaml-2.2/compiler/instr.ml
--- js-of-ocaml-1.4/compiler/instr.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/instr.ml 2014-05-15 08:37:39.000000000 +0000
@@ -111,6 +111,8 @@
| PUSHTRAP
| POPTRAP
| RAISE
+ | RERAISE
+ | RAISE_NOTRACE
| CHECK_SIGNALS
| C_CALL1
| C_CALL2
@@ -178,8 +180,9 @@
type desc = { code : t; kind : kind; name : string; opcode : int }
-let ops =
- Array.mapi (fun i (c, k, n) -> {code = c; kind = k; name = n; opcode = i})
+let ops,ops_rev =
+ let ops_rev = Hashtbl.create 17 in
+ let block1 =
[| ACC0, KNullary, "ACC0";
ACC1, KNullary, "ACC1";
ACC2, KNullary, "ACC2";
@@ -271,8 +274,12 @@
BOOLNOT, KNullary, "BOOLNOT";
PUSHTRAP, KCond_jump, "PUSHTRAP";
POPTRAP, KNullary, "POPTRAP";
- RAISE, KStop 0, "RAISE";
- CHECK_SIGNALS, KNullary, "CHECK_SIGNALS";
+ RAISE, KStop 0, "RAISE" |]
+ and block2 =
+ [| RERAISE, KStop 0, "RERAISE";
+ RAISE_NOTRACE, KStop 0, "RAISE_NOTRACE" |]
+ and block3 =
+ [| CHECK_SIGNALS, KNullary, "CHECK_SIGNALS";
C_CALL1, KUnary, "C_CALL1";
C_CALL2, KUnary, "C_CALL2";
C_CALL3, KUnary, "C_CALL3";
@@ -324,6 +331,37 @@
GETPUBMET, KBinary, "GETPUBMET";
GETDYNMET, KNullary, "GETDYNMET";
STOP, KStop 0, "STOP"|]
+ in
+ let instrs =
+ match Util.Version.v with
+ `V3 -> [block1; block3]
+ | `V4_02 -> [block1; block2; block3]
+ in
+ let ops =
+ Array.mapi
+ (fun i (c, k, n) ->
+ Hashtbl.add ops_rev c i;
+ {code = c; kind = k; name = n; opcode = i})
+ (Array.concat instrs)
+ in
+ ops,ops_rev
+
+let to_int c = Hashtbl.find ops_rev c
+
+let int_to_buf buf i =
+ Buffer.add_char buf (Char.chr (i land 0xFF));
+ Buffer.add_char buf (Char.chr ((i lsr 8) land 0xFF));
+ Buffer.add_char buf (Char.chr ((i lsr 16) land 0xFF));
+ Buffer.add_char buf (Char.chr ((i lsr 24) land 0xFF))
+
+let compile l =
+ let b = Buffer.create 50 in
+ List.iter (fun i ->
+ let i = match i with
+ | `C i -> i
+ | `I i -> to_int i in
+ int_to_buf b i) l;
+ Buffer.contents b
let get code i = Char.code code.[i]
@@ -335,6 +373,8 @@
let b4 = get code (i + 3) in
(b4 lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1
+let getu32 code pc = Int32.of_int (getu code pc)
+
let gets code pc =
let i = pc * 4 in
let b1 = get code i in
@@ -344,6 +384,8 @@
let b4' = if b4 >= 128 then b4-256 else b4 in
(b4' lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1
+let gets32 code pc = Int32.of_int (gets code pc)
+
exception Bad_instruction of int
let get_instr code pc =
diff -Nru js-of-ocaml-1.4/compiler/instr.mli js-of-ocaml-2.2/compiler/instr.mli
--- js-of-ocaml-1.4/compiler/instr.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/instr.mli 2014-05-15 08:37:39.000000000 +0000
@@ -111,6 +111,8 @@
| PUSHTRAP
| POPTRAP
| RAISE
+ | RERAISE
+ | RAISE_NOTRACE
| CHECK_SIGNALS
| C_CALL1
| C_CALL2
@@ -184,6 +186,9 @@
val gets : string -> int -> int
val getu : string -> int -> int
+val gets32 : string -> int -> int32
+val getu32 : string -> int -> int32
-val print_obj : Format.formatter -> Obj.t -> unit
+val compile : [`C of int | `I of t] list -> string
+val print_obj : Format.formatter -> Obj.t -> unit
diff -Nru js-of-ocaml-1.4/compiler/javascript.ml js-of-ocaml-2.2/compiler/javascript.ml
--- js-of-ocaml-1.4/compiler/javascript.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/javascript.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,17 +18,40 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-(*
- variable_declaration_list_no_in
- variable_declaration_no_in
- initialiser_no_in
-...
-
-*)
-type foo = unit
-
-and node_pc = int option
+module Label = struct
+ open Util
+ type t =
+ | L of int
+ | S of string
+
+ let printer = VarPrinter.create ()
+
+ let zero = L 0
+ let succ = function
+ | L t -> L (succ t)
+ | S _ -> assert false
+ let to_string = function
+ | L t -> VarPrinter.to_string printer t
+ | S s -> s
+ let of_string s = S s
+end
+
+type loc = Code.DebugAddr.dbg
+type node_pc =
+ | Loc of loc
+ | Pi of Parse_info.t
+ | N
+
+type identifier = string
+
+type ident_string = {
+ name : identifier;
+ var : Code.Var.t option }
+
+type ident =
+ | S of ident_string
+ | V of Code.Var.t
(* A.3 Expressions *)
@@ -41,13 +64,12 @@
| LslEq | AsrEq | LsrEq | BandEq | BxorEq | BorEq
| Or | And | Bor | Bxor | Band
| EqEq | NotEq | EqEqEq | NotEqEq
- | Lt | Le | InstanceOf
+ | Lt | Le | Gt | Ge | InstanceOf | In
| Lsl | Lsr | Asr
| Plus | Minus
| Mul | Div | Mod
-and unop = Not | Neg | Pl | Typeof | Delete | Bnot | IncrA | DecrA | IncrB | DecrB
-(*XXX*)
+and unop = Not | Neg | Pl | Typeof | Void | Delete | Bnot | IncrA | DecrA | IncrB | DecrB
and arguments = expression list
@@ -67,75 +89,65 @@
| EAccess of expression * expression
| EDot of expression * identifier
| ENew of expression * arguments option
- | EVar of identifier
- | EFun of function_expression * node_pc
- | EStr of string * [`Bytes (*| `Utf8*)]
+ | EVar of ident
+ | EFun of function_expression
+ | EStr of string * [`Bytes | `Utf8]
| EArr of array_litteral
| EBool of bool
| ENum of float
| EObj of property_name_and_value_list
| EQuote of string
+ | ERegexp of string * string option
(****)
(* A.4 Statements *)
and statement =
- Block of block
- | Variable_statement of variable_declaration_list
-(*
- | Empty_statement
-*)
+ Block of block * node_pc
+ | Variable_statement of variable_declaration list
+ | Empty_statement of node_pc
| Expression_statement of expression * node_pc
- | If_statement of expression * statement * statement option
- | Do_while_statement of statement * expression
- | While_statement of expression * statement
- | For_statement of
- expression option * expression option * expression option * statement * node_pc
-(*
- | Iteration_statement
-*)
- | Continue_statement of identifier option
- | Break_statement of identifier option
- | Return_statement of expression option
-(*
- | With_statement
-*)
- | Labelled_statement of identifier * statement
- | Switch_statement of expression * case_clause list * statement_list option
- | Throw_statement of expression
- | Try_statement of block * (identifier * block) option * block option * node_pc
-(*
- | Debugger_statement
-*)
+ | If_statement of expression * statement * statement option * node_pc
+ | Do_while_statement of statement * expression * node_pc
+ | While_statement of expression * statement * node_pc
+ | For_statement of (expression option,variable_declaration list) either * expression option * expression option * statement * node_pc
+ | ForIn_statement of (expression,variable_declaration) either * expression * statement * node_pc
+ | Continue_statement of Label.t option * node_pc
+ | Break_statement of Label.t option * node_pc
+ | Return_statement of expression option * node_pc
+ (* | With_statement of expression * statement *)
+ | Labelled_statement of Label.t * statement * node_pc
+ | Switch_statement of expression * case_clause list * statement_list option * node_pc
+ | Throw_statement of expression * node_pc
+ | Try_statement of block * (ident * block) option * block option * node_pc
+ | Debugger_statement of node_pc
+
+and ('left,'right) either =
+ | Left of 'left
+ | Right of 'right
and block = statement_list
and statement_list = statement list
-and variable_statement = variable_declaration_list
-
-and variable_declaration_list = variable_declaration list
-
-and variable_declaration = identifier * initialiser option
+and variable_declaration = ident * initialiser option
and case_clause = expression * statement_list
-and initialiser = expression
-
-(*... *)
+and initialiser = expression * node_pc
(****)
(* A.5 Functions and programs *)
and function_declaration =
- identifier * formal_parameter_list * function_body * node_pc
+ ident * formal_parameter_list * function_body * node_pc
and function_expression =
- identifier option * formal_parameter_list * function_body
+ ident option * formal_parameter_list * function_body * node_pc
-and formal_parameter_list = identifier list
+and formal_parameter_list = ident list
and function_body = source_elements
@@ -147,4 +159,52 @@
Statement of statement
| Function_declaration of function_declaration
-and identifier = string
+let compare_ident t1 t2 =
+ match t1, t2 with
+ | V v1, V v2 -> Code.Var.compare v1 v2
+ | S {name=s1;var=v1}, S{name=s2;var=v2} -> begin
+ match String.compare s1 s2 with
+ | 0 -> begin match v1,v2 with
+ | None,None -> 0
+ | None, _ -> -1
+ | _, None -> 1
+ | Some v1, Some v2 -> Code.Var.compare v1 v2
+ end
+ | n -> n
+ end
+ | S _, V _ -> -1
+ | V _, S _ -> 1
+
+
+let string_of_number v =
+ if v = infinity
+ then "Infinity"
+ else if v = neg_infinity
+ then "-Infinity"
+ else if v <> v
+ then "NaN"
+ else
+ let vint = int_of_float v in
+ (* compiler 1000 into 1e3 *)
+ if float_of_int vint = v
+ then
+ let rec div n i =
+ if n <> 0 && n mod 10 = 0
+ then div (n/10) (succ i)
+ else
+ if i > 2
+ then Printf.sprintf "%de%d" n i
+ else string_of_int vint in
+ div vint 0
+ else
+ let s1 = Printf.sprintf "%.12g" v in
+ if v = float_of_string s1
+ then s1
+ else
+ let s2 = Printf.sprintf "%.15g" v in
+ if v = float_of_string s2
+ then s2
+ else Printf.sprintf "%.18g" v
+
+module IdentSet = Set.Make(struct type t = ident let compare = compare_ident end)
+module IdentMap = Map.Make(struct type t = ident let compare = compare_ident end)
diff -Nru js-of-ocaml-1.4/compiler/javascript.mli js-of-ocaml-2.2/compiler/javascript.mli
--- js-of-ocaml-1.4/compiler/javascript.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/javascript.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,19 +18,31 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-(*
- variable_declaration_list_no_in
- variable_declaration_no_in
- initialiser_no_in
-...
-
+module Label : sig
+ type t
+ val zero : t
+ val succ : t -> t
+ val to_string : t -> string
+ val of_string : string -> t
+end
+
+type loc = Code.DebugAddr.dbg
+type node_pc =
+ | Loc of loc
+ | Pi of Parse_info.t
+ | N
-*)
-type foo = unit
+(* A.3 Expressions *)
-and node_pc = int option
+type identifier = string
-(* A.3 Expressions *)
+type ident_string = {
+ name : identifier;
+ var : Code.Var.t option }
+
+type ident =
+ | S of ident_string
+ | V of Code.Var.t
and array_litteral = element_list
@@ -41,13 +53,12 @@
| LslEq | AsrEq | LsrEq | BandEq | BxorEq | BorEq
| Or | And | Bor | Bxor | Band
| EqEq | NotEq | EqEqEq | NotEqEq
- | Lt | Le | InstanceOf
+ | Lt | Le | Gt | Ge | InstanceOf | In
| Lsl | Lsr | Asr
| Plus | Minus
| Mul | Div | Mod
-and unop = Not | Neg | Pl | Typeof | Delete | Bnot | IncrA | DecrA | IncrB | DecrB
-(*XXX*)
+and unop = Not | Neg | Pl | Typeof | Void | Delete | Bnot | IncrA | DecrA | IncrB | DecrB
and arguments = expression list
@@ -67,75 +78,72 @@
| EAccess of expression * expression
| EDot of expression * identifier
| ENew of expression * arguments option
- | EVar of identifier
- | EFun of function_expression * node_pc
- | EStr of string * [`Bytes (*| `Utf8*)]
+ | EVar of ident
+ | EFun of function_expression
+ | EStr of string * [`Bytes | `Utf8]
+ (* A string can either be composed of a sequence of bytes, or be
+ UTF-8 encoded. In the second case, the string may contain
+ escape sequences. *)
| EArr of array_litteral
| EBool of bool
| ENum of float
| EObj of property_name_and_value_list
| EQuote of string
+ | ERegexp of string * string option
(****)
(* A.4 Statements *)
and statement =
- Block of block
- | Variable_statement of variable_declaration_list
-(*
- | Empty_statement
-*)
+ Block of block * node_pc
+ | Variable_statement of variable_declaration list
+ | Empty_statement of node_pc
| Expression_statement of expression * node_pc
- | If_statement of expression * statement * statement option
- | Do_while_statement of statement * expression
- | While_statement of expression * statement
- | For_statement of
- expression option * expression option * expression option * statement * node_pc
-(*
- | Iteration_statement
-*)
- | Continue_statement of string option
- | Break_statement of string option
- | Return_statement of expression option
+ | If_statement of expression * statement * statement option * node_pc
+ | Do_while_statement of statement * expression * node_pc
+ | While_statement of expression * statement * node_pc
+ | For_statement of (expression option,variable_declaration list) either * expression option * expression option * statement * node_pc
+ | ForIn_statement of (expression,variable_declaration) either * expression * statement * node_pc
+ | Continue_statement of Label.t option * node_pc
+ | Break_statement of Label.t option * node_pc
+ | Return_statement of expression option * node_pc
(*
| With_statement
*)
- | Labelled_statement of identifier * statement
- | Switch_statement of expression * case_clause list * statement_list option
- | Throw_statement of expression
- | Try_statement of block * (identifier * block) option * block option * node_pc
-(*
- | Debugger_statement
-*)
+ | Labelled_statement of Label.t * statement * node_pc
+ | Switch_statement of expression * case_clause list * statement_list option * node_pc
+ | Throw_statement of expression * node_pc
+ | Try_statement of block * (ident * block) option * block option * node_pc
+
+ | Debugger_statement of node_pc
+
+and ('left,'right) either =
+ | Left of 'left
+ | Right of 'right
+
and block = statement_list
and statement_list = statement list
-and variable_statement = variable_declaration_list
-
-and variable_declaration_list = variable_declaration list
-
-and variable_declaration = identifier * initialiser option
+and variable_declaration = ident * initialiser option
and case_clause = expression * statement_list
-and initialiser = expression
-
-(*... *)
+and initialiser = expression * node_pc
(****)
(* A.5 Functions and programs *)
and function_declaration =
- identifier * formal_parameter_list * function_body * node_pc
+ ident * formal_parameter_list * function_body * node_pc
and function_expression =
- identifier option * formal_parameter_list * function_body
+ ident option * formal_parameter_list * function_body * node_pc
-and formal_parameter_list = identifier list
+and formal_parameter_list = ident list
and function_body = source_elements
@@ -147,4 +155,7 @@
Statement of statement
| Function_declaration of function_declaration
-and identifier = string
+val compare_ident : ident -> ident -> int
+val string_of_number : float -> string
+module IdentSet : Set.S with type elt = ident
+module IdentMap : Map.S with type key = ident
diff -Nru js-of-ocaml-1.4/compiler/js_assign.ml js-of-ocaml-2.2/compiler/js_assign.ml
--- js-of-ocaml-1.4/compiler/js_assign.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_assign.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,303 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Jérôme Vouillon
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+(*
+We are trying to achieve the following goals:
+(1) variable names should be as short as possible
+(2) one should reuse as much as possible a small subsets of variable
+ names
+(3) function parameters should be: function(a,b,...){...}
+(4) for longer variable names, variable which are closed from one
+ another should share a same prefix
+
+Point (1) minimizes the size of uncompressed files, while point (2) to
+(4) improve compression.
+
+We use the following strategy. We maintain the constraint that
+variables occurring in a function should keep different names.
+We first assign names a, b, ... (in order) to function parameters,
+starting from inner functions, skipping variables which have a
+conflict with a previously names variable (goal 3). Then, we order
+the remaining variables by their number of occurrences, then by
+their index (goal 4), and greedily assigned name to them. For that,
+we use for each variable the smallest possible name still available
+(goal 1/2).
+
+This algorithm seems effective. Here are some statistics gathered
+while compiling the OCaml toplevel:
+(1) We get 132025 occurrences of one-char variables out of 169728
+ occurrences while the optimal number (determined using a mixed
+ integer linear programming solver) is 132105 occurrences (80 more
+ occurrences).
+(2) Variable names are heavily biased toward character a: among
+ variables, we have about 34000 occurrences of character a, less
+ than 5000 occurrences of character i (9th character, out of the 54
+ characters that can start an identifier), and about 1500
+ occurrences of character A.
+(3) About 6% of the function parameters are not assigned as wanted;
+ it is not clear we can do any better: there are a lot of nested
+ functions.
+(4) We save 8181 bytes on the compressed file (1.8%) by sorting
+ variables using their index as a secondary key rather that just
+ based on their weights (the size of the uncompressed file remains
+ unchanged)
+*)
+
+open Util
+open Javascript
+
+let debug = Option.Debug.find "shortvar"
+
+module S = Code.VarSet
+module VM = Code.VarMap
+
+module Var = Code.Var
+
+type alloc =
+ { mutable first_free : int;
+ mutable used : bool array }
+
+let make_alloc_table () =
+ { first_free = 0;
+ used = Array.make 32 false }
+
+let next_available a i =
+ let i = ref (max i a.first_free) in
+ let len = Array.length a.used in
+ while !i < len && a.used.(!i) do incr i done;
+ !i
+
+let allocate a i =
+ let len = Array.length a.used in
+ if i >= len then begin
+ let l = ref len in
+ while l := 2 * !l; i >= !l do () done;
+ let u = Array.make !l false in
+ Array.blit a.used 0 u 0 len;
+ a.used <- u
+ end;
+ assert (not a.used.(i));
+ a.used.(i) <- true;
+ if a.first_free = i then begin
+ let i = ref a.first_free in
+ let len = Array.length a.used in
+ while !i < len && a.used.(!i) do incr i done;
+ a.first_free <- !i
+ end
+
+let is_available l i =
+ List.for_all (fun a -> Array.length a.used <= i || not a.used.(i)) l
+
+let first_available l =
+ let rec find_rec n =
+ let n' = List.fold_left (fun n a -> next_available a n) n l in
+ if n = n' then n else find_rec n'
+ in
+ find_rec 0
+
+let mark_allocated l i = List.iter (fun a -> allocate a i) l
+
+type g = {
+ constr : alloc list array; (* Constraints on variables *)
+ mutable parameters : Var.t list array; (* Function parameters *)
+ mutable constraints : S.t list } (* For debugging *)
+
+let create nv =
+ { constr = Array.create nv [];
+ parameters = [|[]|];
+ constraints = [] }
+
+let output_debug_information t count =
+
+
+ let weight v = (IdentMap.find (V v) count) in
+
+ let usage =
+ List.fold_left
+ (fun u s ->
+ S.fold
+ (fun v u -> VM.add v (try 1 + VM.find v u with Not_found -> 1) u)
+ s u)
+ VM.empty t.constraints
+ in
+
+ let l = List.map fst (VM.bindings usage) in
+
+ let ch = open_out "/tmp/weights.txt" in
+ List.iter
+ (fun v ->
+ Printf.fprintf ch "%d / %d / %d\n" (weight v)
+ (VM.find v usage) (Code.Var.idx v))
+ l;
+ close_out ch;
+
+ let ch = open_out "/tmp/problem.txt" in
+ Printf.fprintf ch "Maximize\n";
+ let a = Array.of_list l in
+ Printf.fprintf ch " ";
+ for i = 0 to Array.length a - 1 do
+ let v = a.(i) in
+ let w = weight v in
+ if i > 0 then Printf.fprintf ch " + ";
+ Printf.fprintf ch "%d x%d" w (Code.Var.idx v)
+ done;
+ Printf.fprintf ch "\n";
+ Printf.fprintf ch "Subject To\n";
+ List.iter
+ (fun s ->
+ if S.cardinal s > 0 then begin
+ Printf.fprintf ch " ";
+ let a = Array.of_list (S.elements s) in
+ for i = 0 to Array.length a - 1 do
+ if i > 0 then Printf.fprintf ch " + ";
+ Printf.fprintf ch "x%d" (Code.Var.idx a.(i))
+ done;
+ Printf.fprintf ch "<= 54\n"
+ end)
+ t.constraints;
+ Printf.fprintf ch "Binary\n ";
+ List.iter (fun v -> Printf.fprintf ch " x%d" (Code.Var.idx v)) l;
+ Printf.fprintf ch "\nEnd\n";
+ close_out ch;
+
+ let ch = open_out "/tmp/problem2" in
+ let var x = string_of_int (Code.Var.idx x) in
+ let a = List.map (fun v -> (var v, weight v)) l in
+ let b =
+ List.map (fun s -> List.map var (S.elements s)) t.constraints in
+ let c = List.map var l in
+ output_value ch
+ ((a, b, c) : (string * int) list * string list list * string list);
+ close_out ch
+
+let allocate_variables t nv count =
+ let weight v = try IdentMap.find (V (Code.Var.of_idx v)) count with Not_found -> 0 in
+ let constr = t.constr in
+ let len = nv in
+ let idx = Array.make len 0 in
+ for i = 0 to len - 1 do
+ idx.(i) <- i
+ done;
+ Array.stable_sort (fun i j -> compare (weight j) (weight i)) idx;
+ let name = Array.make len "" in
+ let n0 = ref 0 in
+ let n1 = ref 0 in
+ let n2 = ref 0 in
+ let n3 = ref 0 in
+ let stats i n =
+ incr n0;
+ if n < 54 then begin incr n1; n2 := !n2 + (weight i) end;
+ n3 := !n3 + (weight i)
+ in
+ let nm ~origin n =
+ name.(origin) <- Var.to_string ~origin:(Var.of_idx origin) (Var.of_idx n) in
+ let total = ref 0 in
+ let bad = ref 0 in
+ for i = 0 to Array.length t.parameters - 1 do
+ List.iter
+ (fun x ->
+ incr total;
+ let idx = Var.idx x in
+ let l = constr.(idx) in
+ if is_available l i then begin
+ nm ~origin:idx i;
+ mark_allocated l i;
+ stats idx i
+ end else
+ incr bad)
+ (List.rev t.parameters.(i))
+ done;
+ if debug () then
+ Format.eprintf
+ "Function parameter properly assigned: %d/%d@." (!total - !bad) !total;
+ for i = 0 to len - 1 do
+ let l = constr.(idx.(i)) in
+ if l <> [] && String.length name.(idx.(i)) = 0 then begin
+ let n = first_available l in
+ let idx = idx.(i) in
+ nm ~origin:idx n;
+ mark_allocated l n;
+ stats idx n
+ end;
+ if l = [] then assert (weight (idx.(i)) = 0);
+ done;
+ if debug () then begin
+ Format.eprintf "short variable count: %d/%d@." !n1 !n0;
+ Format.eprintf "short variable occurrences: %d/%d@." !n2 !n3
+ end;
+ name
+
+let add_constraints global u ?(offset=0) params =
+ if Option.Optim.shortvar () then begin
+
+ let constr = global.constr in
+ let c = make_alloc_table () in
+
+ S.iter (fun v -> let i = Code.Var.idx v in constr.(i) <- c :: constr.(i)) u;
+ let params = Array.of_list params in
+ let len = Array.length params in
+ let len_max = len + offset in
+ if Array.length global.parameters < len_max then begin
+ let a = Array.make (2 * len_max) [] in
+ Array.blit global.parameters 0 a 0 (Array.length global.parameters);
+ global.parameters <- a
+ end;
+ for i = 0 to len - 1 do
+ match params.(i) with
+ | V x ->
+ global.parameters.(i + offset) <- x :: global.parameters.(i + offset)
+ | _ -> ()
+ done;
+ global.constraints <- u :: global.constraints
+ end
+
+class ['state] color (state : 'state) = object(m)
+ inherit Js_traverse.free as super
+
+ method block ?(catch =false) params =
+ let offset = if catch then 5 else 0 in
+ let all = S.union m#state.Js_traverse.def m#state.Js_traverse.use in
+ add_constraints state all ~offset params;
+ super#block params
+
+
+end
+
+
+let program p =
+ let color,p =
+ if Option.Optim.shortvar ()
+ then
+ let nv = Code.Var.count () in
+ let state = create nv in
+ let coloring = new color state in
+ let p = coloring#program p in
+ coloring#block [];
+ if S.cardinal (coloring#get_free) <> 0
+ then begin
+ Util.failwith_ "Some variables escaped (#%d)" (S.cardinal (coloring#get_free))
+ (* S.iter(fun s -> (Format.eprintf "%s@." (Code.Var.to_string s))) coloring#get_free *)
+ end;
+ let name = allocate_variables state nv coloring#state.Js_traverse.count in
+ if debug () then output_debug_information state coloring#state.Js_traverse.count;
+ (function V v -> S {name=name.(Code.Var.idx v);var=Some v} | x -> x),p
+ else (function V v -> S {name=Var.to_string v;var=Some v} | x -> x),p
+ in
+ (new Js_traverse.subst color)#program p
diff -Nru js-of-ocaml-1.4/compiler/js_assign.mli js-of-ocaml-2.2/compiler/js_assign.mli
--- js-of-ocaml-1.4/compiler/js_assign.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_assign.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,19 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val program : Javascript.program -> Javascript.program
diff -Nru js-of-ocaml-1.4/compiler/js_lexer.mli js-of-ocaml-2.2/compiler/js_lexer.mli
--- js-of-ocaml-1.4/compiler/js_lexer.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_lexer.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,24 @@
+(* Js_of_ocaml compiler
+ * Copyright (C) 2013 Hugo Heuzard
+ *)
+
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2010 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
+ * license.txt for more details.
+ *)
+
+val initial :
+ (Lexing.lexbuf -> Parse_info.t) ->
+ Js_token.token option -> Lexing.lexbuf -> Js_token.token
+
+val pos : Lexing.lexbuf -> string * int
diff -Nru js-of-ocaml-1.4/compiler/js_lexer.mll js-of-ocaml-2.2/compiler/js_lexer.mll
--- js-of-ocaml-1.4/compiler/js_lexer.mll 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_lexer.mll 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,345 @@
+{
+
+(* Js_of_ocaml compiler
+ * Copyright (C) 2013 Hugo Heuzard
+ *)
+
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2010 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
+ * license.txt for more details.
+ *)
+
+open Js_token
+
+let tok lexbuf = Lexing.lexeme lexbuf
+
+let keyword_table =
+ let h = Hashtbl.create 17 in
+ List.iter (fun (s,f) -> Hashtbl.add h s f ) [
+
+ "catch", (fun ii -> T_CATCH ii);
+ "finally", (fun ii -> T_FINALLY ii);
+ "in", (fun ii -> T_IN ii);
+ "instanceof", (fun ii -> T_INSTANCEOF ii);
+
+ "else", (fun ii -> T_ELSE ii);
+ "while", (fun ii -> T_WHILE ii);
+
+ "break", (fun ii -> T_BREAK ii);
+ "case", (fun ii -> T_CASE ii);
+ "continue", (fun ii -> T_CONTINUE ii);
+ "default", (fun ii -> T_DEFAULT ii);
+ "delete", (fun ii -> T_DELETE ii);
+ "do", (fun ii -> T_DO ii);
+ "else", (fun ii -> T_ELSE ii);
+ "for", (fun ii -> T_FOR ii);
+ "function", (fun ii -> T_FUNCTION ii);
+ "if", (fun ii -> T_IF ii);
+ "new", (fun ii -> T_NEW ii);
+ "return", (fun ii -> T_RETURN ii);
+ "switch", (fun ii -> T_SWITCH ii);
+ "this", (fun ii -> T_THIS ii);
+ "throw", (fun ii -> T_THROW ii);
+ "try", (fun ii -> T_TRY ii);
+ "typeof", (fun ii -> T_TYPEOF ii);
+ "var", (fun ii -> T_VAR ii);
+ "void", (fun ii -> T_VOID ii);
+ "while", (fun ii -> T_WHILE ii);
+ "with", (fun ii -> T_WITH ii);
+ "null", (fun ii -> T_NULL ii);
+ "false", (fun ii -> T_FALSE ii);
+ "true", (fun ii -> T_TRUE ii);
+ "debugger", (fun ii -> T_DEBUGGER ii);
+ ];
+ h
+
+let hexa_to_int = function
+ | '0'..'9' as x -> Char.code x - Char.code '0'
+ | 'a'..'f' as x -> Char.code x - Char.code 'a' + 10
+ | 'A'..'F' as x -> Char.code x - Char.code 'A' + 10
+ | _ -> assert false;;
+
+}
+
+(*****************************************************************************)
+
+let NEWLINE = ("\r"|"\n"|"\r\n")
+let hexa = ['0'-'9''a'-'f''A'-'F']
+let inputCharacter = [^ '\r' '\n' ]
+(*****************************************************************************)
+
+rule initial tokinfo prev = parse
+
+ (* ----------------------------------------------------------------------- *)
+ (* spacing/comments *)
+ (* ----------------------------------------------------------------------- *)
+ | "/*" {
+ let info = tokinfo lexbuf in
+ let buf = Buffer.create 127 in
+ let nl = ref false in
+ st_comment buf nl lexbuf;
+ let content = Buffer.contents buf in
+ if !nl
+ then TCommentML(info,content)
+ else TComment(info,content)
+ }
+ (* don't keep the trailing \n; it will be in another token *)
+ | "//" (inputCharacter* as cmt) { TComment(tokinfo lexbuf,cmt) }
+
+ | ([' ' '\t' ]+ as cmt) { TCommentSpace(tokinfo lexbuf,cmt) }
+ | NEWLINE {
+ lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with
+ Lexing.pos_lnum = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum + 1 };
+ TCommentNewline(tokinfo lexbuf,"") }
+
+ (* ----------------------------------------------------------------------- *)
+ (* symbols *)
+ (* ----------------------------------------------------------------------- *)
+
+ | "{" { T_LCURLY (tokinfo lexbuf); }
+ | "}" { T_RCURLY (tokinfo lexbuf); }
+
+ | "(" { T_LPAREN (tokinfo lexbuf); }
+ | ")" { T_RPAREN (tokinfo lexbuf); }
+
+ | "[" { T_LBRACKET (tokinfo lexbuf); }
+ | "]" { T_RBRACKET (tokinfo lexbuf); }
+ | "." { T_PERIOD (tokinfo lexbuf); }
+ | ";" { T_SEMICOLON (tokinfo lexbuf); }
+ | "," { T_COMMA (tokinfo lexbuf); }
+ | ":" { T_COLON (tokinfo lexbuf); }
+ | "?" { T_PLING (tokinfo lexbuf); }
+ | "&&" { T_AND (tokinfo lexbuf); }
+ | "||" { T_OR (tokinfo lexbuf); }
+ | "===" { T_STRICT_EQUAL (tokinfo lexbuf); }
+ | "!==" { T_STRICT_NOT_EQUAL (tokinfo lexbuf); }
+ | "<=" { T_LESS_THAN_EQUAL (tokinfo lexbuf); }
+ | ">=" { T_GREATER_THAN_EQUAL (tokinfo lexbuf); }
+ | "==" { T_EQUAL (tokinfo lexbuf); }
+ | "!=" { T_NOT_EQUAL (tokinfo lexbuf); }
+ | "++" {
+ let cpi = tokinfo lexbuf in
+ match prev with
+ | Some p when (Js_token.info_of_tok p).Parse_info.line = cpi.Parse_info.line ->
+ T_INCR_NB(cpi)
+ | _ -> T_INCR(cpi) }
+ | "--" {
+ let cpi = tokinfo lexbuf in
+ match prev with
+ | Some p when (Js_token.info_of_tok p).Parse_info.line = cpi.Parse_info.line ->
+ T_DECR_NB(cpi)
+ | _ -> T_DECR(cpi) }
+ | "<<=" { T_LSHIFT_ASSIGN (tokinfo lexbuf); }
+ | "<<" { T_LSHIFT (tokinfo lexbuf); }
+ | ">>=" { T_RSHIFT_ASSIGN (tokinfo lexbuf); }
+ | ">>>=" { T_RSHIFT3_ASSIGN (tokinfo lexbuf); }
+ | ">>>" { T_RSHIFT3 (tokinfo lexbuf); }
+ | ">>" { T_RSHIFT (tokinfo lexbuf); }
+ | "+=" { T_PLUS_ASSIGN (tokinfo lexbuf); }
+ | "-=" { T_MINUS_ASSIGN (tokinfo lexbuf); }
+
+ | "*=" { T_MULT_ASSIGN (tokinfo lexbuf); }
+ | "%=" { T_MOD_ASSIGN (tokinfo lexbuf); }
+ | "&=" { T_BIT_AND_ASSIGN (tokinfo lexbuf); }
+ | "|=" { T_BIT_OR_ASSIGN (tokinfo lexbuf); }
+ | "^=" { T_BIT_XOR_ASSIGN (tokinfo lexbuf); }
+ | "<" { T_LESS_THAN (tokinfo lexbuf); }
+ | ">" { T_GREATER_THAN (tokinfo lexbuf); }
+ | "+" { T_PLUS (tokinfo lexbuf); }
+ | "-" { T_MINUS (tokinfo lexbuf); }
+ | "*" { T_MULT (tokinfo lexbuf); }
+ (* for '/' see below the regexp handling *)
+ | "%" { T_MOD (tokinfo lexbuf); }
+ | "|" { T_BIT_OR (tokinfo lexbuf); }
+ | "&" { T_BIT_AND (tokinfo lexbuf); }
+ | "^" { T_BIT_XOR (tokinfo lexbuf); }
+ | "!" { T_NOT (tokinfo lexbuf); }
+ | "~" { T_BIT_NOT (tokinfo lexbuf); }
+ | "=" { T_ASSIGN (tokinfo lexbuf); }
+
+ (* ----------------------------------------------------------------------- *)
+ (* Keywords and ident *)
+ (* ----------------------------------------------------------------------- *)
+ | ['a'-'z''A'-'Z''$''_']['a'-'z''A'-'Z''$''_''0'-'9']* {
+ let s = tok lexbuf in
+ let info = tokinfo lexbuf in
+ try
+ let f = Hashtbl.find keyword_table s in
+ f info (* need case insensitive ? *)
+ with
+ | Not_found -> T_IDENTIFIER (s, info)
+ }
+
+ (* ----------------------------------------------------------------------- *)
+ (* Constant *)
+ (* ----------------------------------------------------------------------- *)
+
+ | "0" ['X''x'] hexa+ {
+ let s = tok lexbuf in
+ let info = tokinfo lexbuf in
+ T_NUMBER (s, float_of_string s, info)
+ }
+ | '0'['0'-'7']+ {
+ let s = tok lexbuf in
+ let s' = String.sub s 1 (String.length s - 1 ) in
+ let info = tokinfo lexbuf in
+ T_NUMBER (s, Int64.(to_float (of_string ("0o"^s'))), info)
+ }
+
+ | ['0'-'9']*'.'?['0'-'9']+['e''E']['-''+']?['0'-'9']+ (* {1,3} *) {
+ let s = tok lexbuf in
+ let info = tokinfo lexbuf in
+ T_NUMBER (s, float_of_string s,info)
+ }
+
+ | ['0'-'9']+'.'? |
+ ['0'-'9']*'.'['0'-'9']+ {
+ let s = tok lexbuf in
+ let info = tokinfo lexbuf in
+ T_NUMBER (s, float_of_string s, info)
+ }
+
+ (* ----------------------------------------------------------------------- *)
+ (* Strings *)
+ (* ----------------------------------------------------------------------- *)
+ | ("'"|'"') as quote {
+ let info = tokinfo lexbuf in
+ let buf = Buffer.create 127 in
+ string_quote quote buf lexbuf;
+ let s = Buffer.contents buf in
+ (* s does not contain the enclosing "'" but the info does *)
+ T_STRING (s, info)
+ }
+
+ (* ----------------------------------------------------------------------- *)
+ (* Regexp *)
+ (* ----------------------------------------------------------------------- *)
+ (* take care of ambiguity with start of comment //, and with
+ * '/' as a divisor operator
+ *
+ * it can not be '/' [^ '/']* '/' because then
+ * comments will not be recognized as lex tries
+ * to find the longest match.
+ *
+ * It can not be
+ * '/' [^'*''/'] ([^'/''\n'])* '/' ['A'-'Z''a'-'z']*
+ * because a / (b/c) will be recognized as a regexp.
+ *
+ *)
+
+ | "/" | "/=" {
+ let s = tok lexbuf in
+ let info = tokinfo lexbuf in
+
+ match prev with
+ | Some (
+ T_IDENTIFIER _
+ | T_NUMBER _ | T_STRING _ | T_REGEX _
+ | T_FALSE _ | T_TRUE _ | T_NULL _
+ | T_THIS _
+ | T_INCR _ | T_DECR _
+ | T_RBRACKET _ | T_RPAREN _
+ ) -> begin match s with
+ | "/" -> T_DIV (info);
+ | "/=" -> T_DIV_ASSIGN info
+ | _ -> assert false
+ end
+ | _ ->
+ (* raise (Token t); *)
+ let buf = Buffer.create 127 in
+ Buffer.add_string buf s;
+ regexp buf lexbuf;
+ T_REGEX (Buffer.contents buf, info)
+ }
+
+ (* ----------------------------------------------------------------------- *)
+ (* eof *)
+ (* ----------------------------------------------------------------------- *)
+
+ | eof { EOF (tokinfo lexbuf) }
+
+ | _ {
+ Format.eprintf "LEXER:unrecognised symbol, in token rule: %s@." (tok lexbuf);
+ TUnknown (tokinfo lexbuf)
+ }
+(*****************************************************************************)
+
+and string_escape quote buf = parse
+ | '\\'{ Buffer.add_string buf "\\\\" }
+ | 'x' hexa hexa
+ | 'u' hexa hexa hexa hexa {
+ Buffer.add_char buf '\\';
+ Buffer.add_string buf (Lexing.lexeme lexbuf) }
+ | (_ as c)
+ { if c <> '\'' && c <> '\"' then Buffer.add_char buf '\\';
+ Buffer.add_char buf c }
+
+
+and string_quote q buf = parse
+ | ("'"|'"') as q' {
+ if q = q'
+ then ()
+ else (Buffer.add_char buf q'; string_quote q buf lexbuf) }
+ | '\\' {
+ string_escape q buf lexbuf;
+ string_quote q buf lexbuf
+ }
+ | (_ as x) { Buffer.add_char buf x; string_quote q buf lexbuf }
+ | eof { Format.eprintf "LEXER: WIERD end of file in quoted string@."; ()}
+
+(*****************************************************************************)
+and regexp buf = parse
+ | '\\' (_ as x) { Buffer.add_char buf '\\';
+ Buffer.add_char buf x;
+ regexp buf lexbuf }
+ | '/' { Buffer.add_char buf '/'; regexp_maybe_ident buf lexbuf }
+ | '[' { Buffer.add_char buf '['; regexp_class buf lexbuf }
+ | (_ as x) { Buffer.add_char buf x; regexp buf lexbuf }
+ | eof { Format.eprintf "LEXER: WIERD end of file in regexp@."; ()}
+
+and regexp_class buf = parse
+ | ']' { Buffer.add_char buf ']';
+ regexp buf lexbuf }
+ | '\\' (_ as x) { Buffer.add_char buf '\\';
+ Buffer.add_char buf x;
+ regexp_class buf lexbuf }
+ | (_ as x) { Buffer.add_char buf x; regexp_class buf lexbuf }
+
+and regexp_maybe_ident buf = parse
+ | ['A'-'Z''a'-'z']* { Buffer.add_string buf (tok lexbuf) }
+
+(*****************************************************************************)
+
+and st_comment buf nl = parse
+ | "*/" { Buffer.add_string buf (tok lexbuf) }
+
+ (* noteopti: *)
+ | NEWLINE { Buffer.add_string buf (tok lexbuf);
+ nl := true;
+ st_comment buf nl lexbuf }
+ | [^'*' '\n' '\r' ]+ { Buffer.add_string buf (tok lexbuf);st_comment buf nl lexbuf }
+ | '*' { Buffer.add_char buf '*';st_comment buf nl lexbuf }
+
+ | eof { Format.eprintf "LEXER: end of file in comment@."; Buffer.add_string buf "*/"}
+ | _ {
+ let s = tok lexbuf in
+ Format.eprintf "LEXER: unrecognised symbol in comment: %s@." s;
+ Buffer.add_string buf s;
+ st_comment buf nl lexbuf
+ }
+
+and pos = parse
+ | '#' [' ' '\t' ]+ (['0'-'9']+ as line) [' ' '\t' ]+ (("'"|'"') as quote) {
+ let buf = Buffer.create 127 in
+ string_quote quote buf lexbuf;
+ Buffer.contents buf, int_of_string line }
diff -Nru js-of-ocaml-1.4/compiler/js_output.ml js-of-ocaml-2.2/compiler/js_output.ml
--- js-of-ocaml-1.4/compiler/js_output.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_output.ml 2014-05-15 08:37:39.000000000 +0000
@@ -29,861 +29,1055 @@
e ++, e --, continue e, break e, return e, throw e
*)
+let stats = Option.Debug.find "output"
+
open Javascript
module PP = Pretty_print
-let enable_debug = ref false
-let debug_info = ref None
+module Make(D : sig
+ val debug_info : Parse_bytecode.debug_loc
+ val source_map : Source_map.t option
+end) = struct
+
+ let stringsize = ref 0
+
+ let temp_mappings = ref []
+
+ let push_mapping,get_file_index,source_map_enabled =
+ let idx = ref 0 in
+ let files = Hashtbl.create 17 in
+ match D.source_map with
+ | None -> (fun _ _ -> ()),(fun _ -> -1),false
+ | Some sm ->
+ List.iter (fun f -> Hashtbl.add files f !idx; incr idx) sm.Source_map.sources;
+ (fun pos m -> temp_mappings := (pos,m)::!temp_mappings),
+ (fun file ->
+ try Hashtbl.find files file with
+ | Not_found ->
+ let pos = !idx in
+ Hashtbl.add files file pos;
+ incr idx;
+ sm.Source_map.sources <- sm.Source_map.sources @ [file];
+ pos),
+ true
+
+ let debug_enabled = Option.Optim.debuginfo ()
+ let output_debug_info f pc =
+ if source_map_enabled || debug_enabled
+ then
+ let pi = match pc with
+ | N -> None
+ | Loc pc -> D.debug_info pc
+ | Pi pi -> Some pi in
+ match pi with
+ | None -> ()
+ | Some {
+ Parse_info.name=file;
+ line=l;
+ col=s } ->
+ if debug_enabled
+ then begin PP.string f "/*";
+ PP.string f (Format.sprintf "<<%s %d %d>>" file (l + 1) s);
+ PP.string f "*/";
+ end;
+ if source_map_enabled
+ then begin
+ let pos = PP.pos f in
+ push_mapping pos {
+ Source_map.gen_line = -1;
+ gen_col = -1;
+ ori_source=get_file_index file;
+ ori_line = l;
+ ori_col = s;
+ ori_name = None;
+ }
+ end
+
+ let ident f = function
+ | S {name;var=None} -> PP.string f name
+ | S {name;var=Some v} -> PP.string f name
+ | V v -> assert false
-let set_debug_info () = enable_debug := true
+ let opt_identifier f i =
+ match i with
+ None -> ()
+ | Some i -> PP.space f; ident f i
-let output_debug_info f pc =
- if !enable_debug then
- match !debug_info, pc with
- | Some dl, Some pc ->
- (match dl pc with
- | Some (file, l, s, e) ->
- PP.string f "/*";
- PP.string f (Format.sprintf "<<%d: %s %d %d %d>>"
- pc file l s e);
- PP.string f "*/"
- | None -> ())
- | _, _ -> ()
-
-let opt_identifier f i =
- match i with
- None -> ()
- | Some i -> PP.space f; PP.string f i
-
-let rec formal_parameter_list f l =
- match l with
- [] -> ()
- | [i] -> PP.string f i
- | i :: r -> PP.string f i; PP.string f ","; PP.break f;
- formal_parameter_list f r
+ let rec formal_parameter_list f l =
+ match l with
+ [] -> ()
+ | [i] -> ident f i
+ | i :: r -> ident f i; PP.string f ","; PP.break f;
+ formal_parameter_list f r
(*
- 0 Expression
- 1 AssignementExpression
- 2 ConditionalExpression
- 3 LogicalORExpression
- 4 LogicalANDExpression
- 5 BitwiseORExpression
- 6 BitwiseXORExpression
- 7 BitwiseANDExpression
- 8 EqualityExpression
- 9 RelationalExpression
-10 ShiftExpression
-11 AdditiveExpression
-12 MultiplicativeExpression
-13 UnaryExpression
-14 PostfixExpression
-15 LeftHandsideExpression
- NewExpression
- CallExpression
-16 MemberExpression
- FunctionExpression
- PrimaryExpression
+ 0 Expression
+ 1 AssignementExpression
+ 2 ConditionalExpression
+ 3 LogicalORExpression
+ 4 LogicalANDExpression
+ 5 BitwiseORExpression
+ 6 BitwiseXORExpression
+ 7 BitwiseANDExpression
+ 8 EqualityExpression
+ 9 RelationalExpression
+ 10 ShiftExpression
+ 11 AdditiveExpression
+ 12 MultiplicativeExpression
+ 13 UnaryExpression
+ 14 PostfixExpression
+ 15 LeftHandsideExpression
+ NewExpression
+ CallExpression
+ 16 MemberExpression
+ FunctionExpression
+ PrimaryExpression
*)
-let op_prec op =
- match op with
- Eq | StarEq | SlashEq | ModEq | PlusEq | MinusEq
- | LslEq | AsrEq | LsrEq | BandEq | BxorEq | BorEq -> 1, 13, 1
-(*
- | Or -> 3, 3, 4
- | And -> 4, 4, 5
- | Bor -> 5, 5, 6
- | Bxor -> 6, 6, 7
- | Band -> 7, 7, 8
-*)
- | Or -> 3, 3, 3
- | And -> 4, 4, 4
- | Bor -> 5, 5, 5
- | Bxor -> 6, 6, 6
- | Band -> 7, 7, 7
- | EqEq | NotEq | EqEqEq | NotEqEq -> 8, 8, 9
- | Lt | Le | InstanceOf -> 9, 9, 10
- | Lsl | Lsr | Asr -> 10, 10, 11
- | Plus | Minus -> 11, 11, 12
- | Mul | Div | Mod -> 12, 12, 13
-
-let op_str op =
- match op with
- Eq -> "="
- | StarEq -> "*="
- | SlashEq -> "/="
- | ModEq -> "%="
- | PlusEq -> "+="
- | MinusEq -> "-="
- | Or -> "||"
- | And -> "&&"
- | Bor -> "|"
- | Bxor -> "^"
- | Band -> "&"
- | EqEq -> "=="
- | NotEq -> "!="
- | EqEqEq -> "==="
- | NotEqEq -> "!=="
- | LslEq -> "<<="
- | AsrEq -> ">>="
- | LsrEq -> ">>>="
- | BandEq -> "&="
- | BxorEq -> "^="
- | BorEq -> "|="
- | Lt -> "<"
- | Le -> "<="
- | Lsl -> "<<"
- | Lsr -> ">>>"
- | Asr -> ">>"
- | Plus -> "+"
- | Minus -> "-"
- | Mul -> "*"
- | Div -> "/"
- | Mod -> "%"
- | InstanceOf -> assert false
-
-let unop_str op =
- match op with
- Not -> "!"
- | Neg -> "-"
- | Pl -> "+"
- | Bnot -> "~"
- | IncrA | IncrB | DecrA | DecrB
- | Typeof | Delete -> assert false
+ let op_prec op =
+ match op with
+ Eq | StarEq | SlashEq | ModEq | PlusEq | MinusEq
+ | LslEq | AsrEq | LsrEq | BandEq | BxorEq | BorEq -> 1, 13, 1
+ (*
+ | Or -> 3, 3, 4
+ | And -> 4, 4, 5
+ | Bor -> 5, 5, 6
+ | Bxor -> 6, 6, 7
+ | Band -> 7, 7, 8
+ *)
+ | Or -> 3, 3, 3
+ | And -> 4, 4, 4
+ | Bor -> 5, 5, 5
+ | Bxor -> 6, 6, 6
+ | Band -> 7, 7, 7
+ | EqEq | NotEq | EqEqEq | NotEqEq -> 8, 8, 9
+ | Gt | Ge | Lt | Le | InstanceOf | In -> 9, 9, 10
+ | Lsl | Lsr | Asr -> 10, 10, 11
+ | Plus | Minus -> 11, 11, 12
+ | Mul | Div | Mod -> 12, 12, 13
+
+ let op_str op =
+ match op with
+ Eq -> "="
+ | StarEq -> "*="
+ | SlashEq -> "/="
+ | ModEq -> "%="
+ | PlusEq -> "+="
+ | MinusEq -> "-="
+ | Or -> "||"
+ | And -> "&&"
+ | Bor -> "|"
+ | Bxor -> "^"
+ | Band -> "&"
+ | EqEq -> "=="
+ | NotEq -> "!="
+ | EqEqEq -> "==="
+ | NotEqEq -> "!=="
+ | LslEq -> "<<="
+ | AsrEq -> ">>="
+ | LsrEq -> ">>>="
+ | BandEq -> "&="
+ | BxorEq -> "^="
+ | BorEq -> "|="
+ | Lt -> "<"
+ | Le -> "<="
+ | Gt -> ">"
+ | Ge -> ">="
+ | Lsl -> "<<"
+ | Lsr -> ">>>"
+ | Asr -> ">>"
+ | Plus -> "+"
+ | Minus -> "-"
+ | Mul -> "*"
+ | Div -> "/"
+ | Mod -> "%"
+ | InstanceOf
+ | In -> assert false
+
+ let unop_str op =
+ match op with
+ Not -> "!"
+ | Neg -> "-"
+ | Pl -> "+"
+ | Bnot -> "~"
+ | IncrA | IncrB | DecrA | DecrB
+ | Typeof | Void | Delete -> assert false
(*XXX May need to be updated... *)
-let rec ends_with_if_without_else st =
- match st with
- If_statement (_, _, Some st) -> ends_with_if_without_else st
- | If_statement (_, _, None) -> true
- | While_statement (_, st) -> ends_with_if_without_else st
- | _ -> false
-
-let rec need_paren l e =
- match e with
- ESeq (e, _) ->
- l <= 0 && need_paren 0 e
- | ECond (e, _, _) ->
- l <= 2 && need_paren 3 e
- | EBin (op, e, _) ->
- let (out, lft, rght) = op_prec op in
- l <= out && need_paren lft e
- | ECall (e, _) | EAccess (e, _) | EDot (e, _) ->
- l <= 15 && need_paren 15 e
- | EVar _ | EStr _ | EArr _ | EBool _ | ENum _ | EQuote _ | EUn _ | ENew _ ->
- false
- | EFun (_, _) | EObj _ ->
- true
-
-let string_escape s =
- let l = String.length s in
- let b = Buffer.create (4 * l) in
- let conv = "0123456789abcdef" in
- for i = 0 to l - 1 do
- let c = s.[i] in
- match c with
- '\000' when i = l - 1 || s.[i + 1] < '0' || s.[i + 1] > '9' ->
- Buffer.add_string b "\\0"
- | '\b' ->
- Buffer.add_string b "\\b"
- | '\t' ->
- Buffer.add_string b "\\t"
- | '\n' ->
- Buffer.add_string b "\\n"
-(* This escape sequence is not supported by IE < 9
- | '\011' ->
- Buffer.add_string b "\\v"
-*)
- | '\012' ->
- Buffer.add_string b "\\f"
- | '\r' ->
- Buffer.add_string b "\\r"
- | '"' ->
- Buffer.add_string b "\\\""
- | '\\' ->
- Buffer.add_string b "\\\\"
- | '\000' .. '\031' | '\127' .. '\255' ->
- let c = Char.code c in
- Buffer.add_string b "\\x";
- Buffer.add_char b conv.[c lsr 4];
- Buffer.add_char b conv.[c land 0xf]
- | _ ->
- Buffer.add_char b c
- done;
- Buffer.contents b
-
-let rec expression l f e =
- match e with
- EVar v ->
- PP.string f v
- | ESeq (e1, e2) ->
- if l > 0 then begin PP.start_group f 1; PP.string f "(" end;
- expression 0 f e1;
- PP.string f ",";
- PP.break f;
- expression 0 f e2;
- if l > 0 then begin PP.string f ")"; PP.end_group f end
- | EFun ((i, l, b), pc) ->
- output_debug_info f pc;
- PP.start_group f 1;
- PP.start_group f 0;
- PP.start_group f 0;
- PP.string f "function";
- opt_identifier f i;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- formal_parameter_list f l;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "{";
- function_body f b;
- PP.string f "}";
- PP.end_group f;
- PP.end_group f
- | ECall (e, el) ->
- if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 1;
- expression 15 f e;
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- arguments f el;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- if l > 15 then begin PP.string f ")"; PP.end_group f end
- | EStr (s, `Bytes) ->
- PP.string f "\"";
- PP.string f (string_escape s);
- PP.string f "\""
- | EBool b ->
- PP.string f (if b then "true" else "false")
- | ENum v ->
- if v = infinity then
- PP.string f "Infinity"
- else if v = neg_infinity then begin
- if l > 13 then
- PP.string f "(-Infinity)"
- else
- PP.string f "-Infinity"
- end else if v <> v then
- PP.string f "NaN"
- else begin
- let s =
- let vint = int_of_float v in
- (* compiler 1000 into 1e3 *)
- if float_of_int vint = v
+ let rec ends_with_if_without_else st =
+ match st with
+ | If_statement (_, _, Some st,_)
+ | While_statement (_, st, _)
+ | For_statement (_, _, _, st, _)
+ | ForIn_statement (_, _, st, _) ->
+ ends_with_if_without_else st
+ | If_statement (_, _, None, _) ->
+ true
+ | _ ->
+ false
+
+ let rec need_paren l e =
+ match e with
+ ESeq (e, _) ->
+ l <= 0 && need_paren 0 e
+ | ECond (e, _, _) ->
+ l <= 2 && need_paren 3 e
+ | EBin (op, e, _) ->
+ let (out, lft, rght) = op_prec op in
+ l <= out && need_paren lft e
+ | ECall (e, _) | EAccess (e, _) | EDot (e, _) ->
+ l <= 15 && need_paren 15 e
+ | EVar _ | EStr _ | EArr _ | EBool _ | ENum _ | EQuote _ | ERegexp _| EUn _ | ENew _ ->
+ false
+ | EFun _ | EObj _ ->
+ true
+
+ let best_string_quote s =
+ let simple = ref 0 and double = ref 0 in
+ for i = 0 to String.length s - 1 do
+ match s.[i] with
+ | '\'' -> incr simple
+ | '"' -> incr double
+ | _ -> ()
+ done;
+ if !simple < !double
+ then '\''
+ else '"'
+
+ let string_escape f quote ?(utf=false) s =
+ let l = String.length s in
+ let conv = "0123456789abcdef" in
+ for i = 0 to l - 1 do
+ let c = s.[i] in
+ let str = match c with
+ '\000' when i = l - 1 || s.[i + 1] < '0' || s.[i + 1] > '9' -> "\\0"
+ | '\b' -> "\\b"
+ | '\t' -> "\\t"
+ | '\n' -> "\\n"
+ (* This escape sequence is not supported by IE < 9
+ | '\011' -> "\\v"
+ *)
+ | '\012' -> "\\f"
+ | '\\' when not utf -> "\\\\"
+ | '\r' -> "\\r"
+ | '\000' .. '\031' | '\127'->
+ let c = Char.code c in
+ let s = String.create 4 in
+ s.[0] <- '\\';
+ s.[1] <- 'x';
+ s.[2] <- conv.[c lsr 4];
+ s.[3] <- conv.[c land 0xf];
+ s
+ | '\128' .. '\255' when not utf ->
+ let c = Char.code c in
+ let s = String.create 4 in
+ s.[0] <- '\\';
+ s.[1] <- 'x';
+ s.[2] <- conv.[c lsr 4];
+ s.[3] <- conv.[c land 0xf];
+ s
+ | _ ->
+ if c = quote
then
- let rec div n i =
- if n <> 0 && n mod 10 = 0
- then div (n/10) (succ i)
- else
- if i > 2
- then Printf.sprintf "%de%d" n i
- else string_of_int vint in
- div vint 0
+ let s = String.create 2 in
+ s.[0] <- '\\';
+ s.[1] <- c;
+ s
else
- let s1 = Printf.sprintf "%.12g" v in
- if v = float_of_string s1 then s1 else
- let s2 = Printf.sprintf "%.15g" v in
- if v = float_of_string s2 then s2 else
- Printf.sprintf "%.18g" v
+ String.make 1 c
+ in
+ stringsize:=!stringsize + String.length str;
+ PP.string f str
+ done;
+ stringsize:=!stringsize+2
+
+ let rec expression l f e =
+ match e with
+ EVar v ->
+ ident f v
+ | ESeq (e1, e2) ->
+ if l > 0 then begin PP.start_group f 1; PP.string f "(" end;
+ expression 0 f e1;
+ PP.string f ",";
+ PP.break f;
+ expression 0 f e2;
+ if l > 0 then begin PP.string f ")"; PP.end_group f end
+ | EFun (i, l, b, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.start_group f 0;
+ PP.string f "function";
+ opt_identifier f i;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ formal_parameter_list f l;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "{";
+ function_body f b;
+ PP.string f "}";
+ PP.end_group f;
+ PP.end_group f
+ | ECall (e, el) ->
+ if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 1;
+ expression 15 f e;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ arguments f el;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ if l > 15 then begin PP.string f ")"; PP.end_group f end
+ | EStr (s, kind) ->
+ let quote = best_string_quote s in
+ let quote_s = String.make 1 quote in
+ PP.string f quote_s;
+ string_escape f ~utf:(kind = `Utf8) quote s;
+ PP.string f quote_s
+ | EBool b ->
+ PP.string f (if b then "true" else "false")
+ | ENum v ->
+ let s = Javascript.string_of_number v in
+ let need_parent =
+ if s.[0] = '-'
+ then l > 13 (* Negative numbers may need to be parenthesized. *)
+ else l = 15 (* Parenthesize as well when followed by a dot. *)
+ && s.[0] <> 'I' (* Infinity *)
+ && s.[0] <> 'N' (* NaN *)
in
- if
- (* Negative numbers may need to be parenthesized. *)
- (l > 13 && (v < 0. || (v = 0. && 1. /. v < 0.)))
- ||
- (* Parenthesize as well when followed by a dot. *)
- (l = 15)
- then begin
- PP.string f "("; PP.string f s; PP.string f ")"
- end else
- PP.string f s
- end
- | EUn (Typeof, e) ->
- if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 0;
- PP.string f "typeof";
- PP.space f;
- expression 13 f e;
- PP.end_group f;
- if l > 13 then begin PP.string f ")"; PP.end_group f end
- | EUn (Delete, e) ->
- if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 0;
- PP.string f "delete";
- PP.space f;
- expression 13 f e;
- PP.end_group f;
- if l > 13 then begin PP.string f ")"; PP.end_group f end
- | EUn ((IncrA | DecrA | IncrB | DecrB) as op,e) ->
- if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
- if op = IncrA || op = DecrA
- then expression 13 f e;
- if op = IncrA || op = IncrB
- then PP.string f "++"
- else PP.string f "--";
- if op = IncrB || op = DecrB
- then expression 13 f e;
- if l > 13 then begin PP.string f ")"; PP.end_group f end
- | EUn (op, e) ->
- if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
- PP.string f (unop_str op);
- expression 13 f e;
- if l > 13 then begin PP.string f ")"; PP.end_group f end
- | EBin (InstanceOf, e1, e2) ->
- let (out, lft, rght) = op_prec InstanceOf in
- if l > out then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 0;
- expression lft f e1;
- PP.space f;
- PP.string f "instanceof";
- PP.space f;
- expression rght f e2;
- PP.end_group f;
- if l > out then begin PP.string f ")"; PP.end_group f end
- | EBin (op, e1, e2) ->
- let (out, lft, rght) = op_prec op in
- if l > out then begin PP.start_group f 1; PP.string f "(" end;
- expression lft f e1;
- PP.string f (op_str op);
- PP.break f;
- expression rght f e2;
- if l > out then begin PP.string f ")"; PP.end_group f end
- | EArr el ->
- PP.start_group f 1;
- PP.string f "[";
- element_list f el;
- PP.string f "]";
- PP.end_group f
- | EAccess (e, e') ->
- if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 1;
- expression 15 f e;
- PP.break f;
- PP.start_group f 1;
- PP.string f "[";
- expression 0 f e';
- PP.string f "]";
- PP.end_group f;
- PP.end_group f;
- if l > 15 then begin PP.string f ")"; PP.end_group f end
- | EDot (e, nm) ->
- if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
- expression 15 f e;
- PP.string f ".";
- PP.string f nm;
- if l > 15 then begin PP.string f ")"; PP.end_group f end
- | ENew (e, None) -> (*FIX: should omit parentheses when possible*)
- if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ if need_parent then PP.string f "(";
+ PP.string f s;
+ if need_parent then PP.string f ")";
+ | EUn (Typeof, e) ->
+ if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 0;
+ PP.string f "typeof";
+ PP.space f;
+ expression 13 f e;
+ PP.end_group f;
+ if l > 13 then begin PP.string f ")"; PP.end_group f end
+ | EUn (Void, e) ->
+ if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 0;
+ PP.string f "void";
+ PP.space f;
+ expression 13 f e;
+ PP.end_group f;
+ if l > 13 then begin PP.string f ")"; PP.end_group f end
+ | EUn (Delete, e) ->
+ if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 0;
+ PP.string f "delete";
+ PP.space f;
+ expression 13 f e;
+ PP.end_group f;
+ if l > 13 then begin PP.string f ")"; PP.end_group f end
+ | EUn ((IncrA | DecrA | IncrB | DecrB) as op,e) ->
+ if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
+ if op = IncrA || op = DecrA
+ then expression 13 f e;
+ if op = IncrA || op = IncrB
+ then PP.string f "++"
+ else PP.string f "--";
+ if op = IncrB || op = DecrB
+ then expression 13 f e;
+ if l > 13 then begin PP.string f ")"; PP.end_group f end
+ | EUn (op, e) ->
+ if l > 13 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.string f (unop_str op);
+ expression 13 f e;
+ if l > 13 then begin PP.string f ")"; PP.end_group f end
+ | EBin (InstanceOf, e1, e2) ->
+ let (out, lft, rght) = op_prec InstanceOf in
+ if l > out then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 0;
+ expression lft f e1;
+ PP.space f;
+ PP.string f "instanceof";
+ PP.space f;
+ expression rght f e2;
+ PP.end_group f;
+ if l > out then begin PP.string f ")"; PP.end_group f end
+ | EBin (In, e1, e2) ->
+ let (out, lft, rght) = op_prec InstanceOf in
+ if l > out then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 0;
+ expression lft f e1;
+ PP.space f;
+ PP.string f "in";
+ PP.space f;
+ expression rght f e2;
+ PP.end_group f;
+ if l > out then begin PP.string f ")"; PP.end_group f end
+ | EBin (op, e1, e2) ->
+ let (out, lft, rght) = op_prec op in
+ if l > out then begin PP.start_group f 1; PP.string f "(" end;
+ expression lft f e1;
+ PP.string f (op_str op);
+ PP.break f;
+ expression rght f e2;
+ if l > out then begin PP.string f ")"; PP.end_group f end
+ | EArr el ->
+ PP.start_group f 1;
+ PP.string f "[";
+ element_list f el;
+ PP.string f "]";
+ PP.end_group f
+ | EAccess (e, e') ->
+ if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 1;
+ expression 15 f e;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "[";
+ expression 0 f e';
+ PP.string f "]";
+ PP.end_group f;
+ PP.end_group f;
+ if l > 15 then begin PP.string f ")"; PP.end_group f end
+ | EDot (e, nm) ->
+ if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ expression 15 f e;
+ PP.string f ".";
+ PP.string f nm;
+ if l > 15 then begin PP.string f ")"; PP.end_group f end
+ | ENew (e, None) -> (*FIX: should omit parentheses when possible*)
+ if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 1;
+ PP.string f "new";
+ PP.space f;
+ expression 16 f e;
+ PP.break f;
+ PP.string f "()";
+ PP.end_group f;
+ if l > 15 then begin PP.string f ")"; PP.end_group f end
+ | ENew (e, Some el) ->
+ if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 1;
+ PP.string f "new";
+ PP.space f;
+ expression 16 f e;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ arguments f el;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ if l > 15 then begin PP.string f ")"; PP.end_group f end
+ | ECond (e, e1, e2) ->
+ if l > 2 then begin PP.start_group f 1; PP.string f "(" end;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ expression 3 f e;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "?";
+ expression 1 f e1;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f ":";
+ expression 1 f e2;
+ PP.end_group f;
+ PP.end_group f;
+ if l > 2 then begin PP.string f ")"; PP.end_group f end
+ | EObj lst ->
+ PP.start_group f 1;
+ PP.string f "{";
+ property_name_and_value_list f lst;
+ PP.string f "}";
+ PP.end_group f
+ | ERegexp (s,opt) -> begin
+ PP.string f "/";PP.string f s;PP.string f "/";
+ match opt with
+ | None -> ()
+ | Some o -> PP.string f o
+ end
+ | EQuote s ->
+ PP.string f "(";
+ PP.string f s;
+ PP.string f ")"
+
+ and property_name f n =
+ match n with
+ PNI s -> PP.string f s
+ | PNS s ->
+ let quote = best_string_quote s in
+ let quote_s = String.make 1 quote in
+ PP.string f quote_s;
+ string_escape f ~utf:true quote s;
+ PP.string f quote_s
+ | PNN v -> expression 0 f (ENum v)
+
+ and property_name_and_value_list f l =
+ match l with
+ [] ->
+ ()
+ | [(pn, e)] ->
+ PP.start_group f 0;
+ property_name f pn;
+ PP.string f ":";
+ PP.break f;
+ expression 1 f e;
+ PP.end_group f
+ | (pn, e) :: r ->
+ PP.start_group f 0;
+ property_name f pn;
+ PP.string f ":";
+ PP.break f;
+ expression 1 f e;
+ PP.end_group f;
+ PP.string f ",";
+ PP.break f;
+ property_name_and_value_list f r
+
+ and element_list f el =
+ match el with
+ [] ->
+ ()
+ | [e] ->
+ begin match e with
+ None -> PP.string f ","
+ | Some e -> PP.start_group f 0; expression 1 f e; PP.end_group f
+ end
+ | e :: r ->
+ begin match e with
+ None -> ()
+ | Some e -> PP.start_group f 0; expression 1 f e; PP.end_group f
+ end;
+ PP.string f ","; PP.break f; element_list f r
+
+ and function_body f b = source_elements f ~skip_last_semi:true b
+
+ and arguments f l =
+ match l with
+ [] -> ()
+ | [e] -> PP.start_group f 0; expression 1 f e; PP.end_group f
+ | e :: r -> PP.start_group f 0; expression 1 f e; PP.end_group f;
+ PP.string f ","; PP.break f; arguments f r
+
+ and variable_declaration f (i, init) =
+ match init with
+ None ->
+ ident f i
+ | Some (e,pc) ->
+ PP.start_group f 1;
+ ident f i;
+ PP.string f "=";
+ PP.break f;
+ output_debug_info f pc;
+ expression 1 f e;
+ PP.end_group f
+
+ and variable_declaration_list_aux f l =
+ match l with
+ [] -> assert false
+ | [d] -> variable_declaration f d
+ | d :: r -> variable_declaration f d; PP.string f ","; PP.break f;
+ variable_declaration_list_aux f r
+
+ and variable_declaration_list close f = function
+ | [] -> ()
+ | [(i, None)] ->
PP.start_group f 1;
- PP.string f "new";
+ PP.string f "var";
PP.space f;
- expression 16 f e;
- PP.break f;
- PP.string f "()";
- PP.end_group f;
- if l > 15 then begin PP.string f ")"; PP.end_group f end
- | ENew (e, Some el) ->
- if l > 15 then begin PP.start_group f 1; PP.string f "(" end;
+ ident f i;
+ if close then PP.string f ";";
+ PP.end_group f
+ | [(i, Some (e,pc))] ->
PP.start_group f 1;
- PP.string f "new";
+ PP.string f "var";
PP.space f;
- expression 16 f e;
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- arguments f el;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- if l > 15 then begin PP.string f ")"; PP.end_group f end
- | ECond (e, e1, e2) ->
- if l > 2 then begin PP.start_group f 1; PP.string f "(" end;
- PP.start_group f 1;
- PP.start_group f 0;
- expression 3 f e;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "?";
- expression 1 f e1;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f ":";
- expression 1 f e2;
- PP.end_group f;
- PP.end_group f;
- if l > 2 then begin PP.string f ")"; PP.end_group f end
- | EObj lst ->
- PP.start_group f 1;
- PP.string f "{";
- property_name_and_value_list f lst;
- PP.string f "}";
- PP.end_group f
- | EQuote s ->
- PP.string f "(";
- PP.string f s;
- PP.string f ")"
-
-and property_name f n =
- match n with
- PNI s -> PP.string f s
- | PNS s -> PP.string f "\""; PP.string f s; PP.string f "\""
- | PNN v -> expression 0 f (ENum v)
-
-and property_name_and_value_list f l =
- match l with
- [] ->
- ()
- | [(pn, e)] ->
- PP.start_group f 0;
- property_name f pn;
- PP.string f ":";
- PP.break f;
- expression 1 f e;
- PP.end_group f
- | (pn, e) :: r ->
+ ident f i;
+ PP.string f "=";
+ PP.break1 f;
PP.start_group f 0;
- property_name f pn;
- PP.string f ":";
- PP.break f;
+ output_debug_info f pc;
expression 1 f e;
+ if close then PP.string f ";";
PP.end_group f;
- PP.string f ",";
- PP.break f;
- property_name_and_value_list f r
-
-and element_list f el =
- match el with
- [] ->
- ()
- | [e] ->
- begin match e with
- None -> PP.string f ","
- | Some e -> PP.start_group f 0; expression 1 f e; PP.end_group f
- end
- | e :: r ->
- begin match e with
- None -> ()
- | Some e -> PP.start_group f 0; expression 1 f e; PP.end_group f
- end;
- PP.string f ","; PP.break f; element_list f r
-
-and function_body f b = source_elements f b
-
-and arguments f l =
- match l with
- [] -> ()
- | [e] -> PP.start_group f 0; expression 1 f e; PP.end_group f
- | e :: r -> PP.start_group f 0; expression 1 f e; PP.end_group f;
- PP.string f ","; PP.break f; arguments f r
-
-and variable_declaration f (i, init) =
- match init with
- None ->
- PP.string f i
- | Some e ->
+ PP.end_group f
+ | l ->
PP.start_group f 1;
- PP.string f i; PP.string f "="; PP.break f; expression 1 f e;
+ PP.string f "var";
+ PP.space f;
+ variable_declaration_list_aux f l;
+ if close then PP.string f ";";
PP.end_group f
-and variable_declaration_list f l =
- match l with
- [] -> assert false
- | [d] -> variable_declaration f d
- | d :: r -> variable_declaration f d; PP.string f ","; PP.break f;
- variable_declaration_list f r
-
-and opt_expression l f e =
- match e with
- None -> ()
- | Some e -> expression l f e
-
-and statement f s =
- match s with
- Block b ->
- block f b
- | Variable_statement l ->
- begin match l with
- [] ->
- ()
- | [(i, None)] ->
+
+ and opt_expression l f e =
+ match e with
+ None -> ()
+ | Some e -> expression l f e
+
+ and statement ?(last=false) f s =
+ let last_semi () = if last then () else PP.string f ";" in
+ match s with
+ | Block (b,pc) ->
+ output_debug_info f pc;
+ block f b
+ | Variable_statement l ->
+ variable_declaration_list (not last) f l
+ | Empty_statement _ -> PP.string f ";"
+ | Debugger_statement pc ->
+ output_debug_info f pc;
+ PP.string f "debugger"; last_semi ()
+ | Expression_statement (EVar _, pc)-> last_semi()
+ | Expression_statement (e, pc) ->
+ (* Parentheses are required when the expression
+ starts syntactically with "{" or "function" *)
+ output_debug_info f pc;
+ if need_paren 0 e then begin
PP.start_group f 1;
- PP.string f "var";
- PP.space f;
- PP.string f i;
- PP.string f ";";
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ last_semi();
PP.end_group f
- | [(i, Some e)] ->
- PP.start_group f 1;
- PP.string f "var";
- PP.space f;
- PP.string f i;
- PP.string f "=";
- PP.genbreak f "" 1;
+ end else begin
PP.start_group f 0;
- expression 1 f e;
- PP.string f ";";
- PP.end_group f;
- PP.end_group f
- | l ->
- PP.start_group f 1;
- PP.string f "var";
- PP.space f;
- variable_declaration_list f l;
- PP.string f ";";
+ expression 0 f e;
+ last_semi();
PP.end_group f
- end
- | Expression_statement (EVar _, pc)-> ()
- | Expression_statement (e, pc) ->
- (* Parentheses are required when the expression
- starts syntactically with "{" or "function" *)
- output_debug_info f pc;
- if need_paren 0 e then begin
+ end
+ | If_statement (e, s1, (Some _ as s2),pc) when ends_with_if_without_else s1 ->
+ output_debug_info f pc;
+ (* Dangling else issue... *)
+ statement ~last f (If_statement (e, Block ([s1],N), s2, pc))
+ | If_statement (e, s1, Some (Block _ as s2),pc) ->
+ output_debug_info f pc;
+ PP.start_group f 0;
+ PP.start_group f 1;
+ PP.string f "if";
+ PP.break f;
PP.start_group f 1;
PP.string f "(";
expression 0 f e;
- PP.string f ");";
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break1 f;
+ PP.start_group f 0;
+ statement f s1;
+ PP.end_group f;
+ PP.break f;
+ PP.string f "else";
+ PP.break1 f;
+ PP.start_group f 0;
+ statement ~last f s2;
+ PP.end_group f;
PP.end_group f
- end else begin
+ | If_statement (e, s1, Some s2, pc) ->
+ output_debug_info f pc;
PP.start_group f 0;
+ PP.start_group f 1;
+ PP.string f "if";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
expression 0 f e;
- PP.string f ";";
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break1 f;
+ PP.start_group f 0;
+ statement f s1;
+ PP.end_group f;
+ PP.break f;
+ PP.string f "else";
+ PP.space ~indent:1 f;
+ PP.start_group f 0;
+ statement ~last f s2;
+ PP.end_group f;
PP.end_group f
- end
- | If_statement (e, s1, (Some _ as s2)) when ends_with_if_without_else s1 ->
- (* Dangling else issue... *)
- statement f (If_statement (e, Block [s1], s2))
- | If_statement (e, s1, Some (Block _ as s2)) ->
- PP.start_group f 0;
- PP.start_group f 1;
- PP.string f "if";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.genbreak f "" 1;
- PP.start_group f 0;
- statement f s1;
- PP.end_group f;
- PP.break f;
- PP.string f "else";
- PP.genbreak f "" 1;
- PP.start_group f 0;
- statement f s2;
- PP.end_group f;
- PP.end_group f
- | If_statement (e, s1, Some s2) ->
- PP.start_group f 0;
- PP.start_group f 1;
- PP.string f "if";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.genbreak f "" 1;
- PP.start_group f 0;
- statement f s1;
- PP.end_group f;
- PP.break f;
- PP.string f "else";
- PP.genbreak f " " 1;
- PP.start_group f 0;
- statement f s2;
- PP.end_group f;
- PP.end_group f
- | If_statement (e, s1, None) ->
- PP.start_group f 1;
- PP.start_group f 0;
- PP.string f "if";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 0;
- statement f s1;
- PP.end_group f;
- PP.end_group f
- | While_statement (e, s) ->
- PP.start_group f 1;
- PP.start_group f 0;
- PP.string f "while";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 0;
- statement f s;
- PP.end_group f;
- PP.end_group f
- | Do_while_statement (Block _ as s, e) ->
- PP.start_group f 0;
- PP.string f "do";
- PP.genbreak f "" 1;
- PP.start_group f 0;
- statement f s;
- PP.end_group f;
- PP.break f;
- PP.string f "while";
- PP.genbreak f "" 1;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f
- | Do_while_statement (s, e) ->
- PP.start_group f 0;
- PP.string f "do";
- PP.genbreak f " " 1;
- PP.start_group f 0;
- statement f s;
- PP.end_group f;
- PP.break f;
- PP.string f "while";
- PP.genbreak f "" 1;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f
- | For_statement (e1, e2, e3, s, pc) ->
- output_debug_info f pc;
- PP.start_group f 1;
- PP.start_group f 0;
- PP.string f "for";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- opt_expression 0 f e1;
- PP.string f ";"; PP.break f;
- opt_expression 0 f e2;
- PP.string f ";"; PP.break f;
- opt_expression 0 f e3;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 0;
- statement f s;
- PP.end_group f;
- PP.end_group f
- | Continue_statement None ->
- PP.string f "continue;"
- | Continue_statement (Some s) ->
- PP.string f "continue ";
- PP.string f s;
- PP.string f ";"
- | Break_statement None ->
- PP.string f "break;"
- | Break_statement (Some s) ->
- PP.string f "break ";
- PP.string f s;
- PP.string f ";"
- | Return_statement e ->
- begin match e with
- None ->
- PP.string f "return;"
- | Some (EFun ((i, l, b), pc)) ->
- output_debug_info f pc;
- PP.start_group f 1;
- PP.start_group f 0;
- PP.start_group f 0;
- PP.string f "return function";
- opt_identifier f i;
- PP.end_group f;
- PP.break f;
+ | If_statement (e, s1, None, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.string f "if";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 0;
+ statement ~last f s1;
+ PP.end_group f;
+ PP.end_group f
+ | While_statement (e, s, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.string f "while";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 0;
+ statement ~last f s;
+ PP.end_group f;
+ PP.end_group f
+ | Do_while_statement (Block _ as s, e, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 0;
+ PP.string f "do";
+ PP.break1 f;
+ PP.start_group f 0;
+ statement f s;
+ PP.end_group f;
+ PP.break f;
+ PP.string f "while";
+ PP.break1 f;
+ PP.start_group f 1;
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ last_semi();
+ PP.end_group f;
+ PP.end_group f
+ | Do_while_statement (s, e, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 0;
+ PP.string f "do";
+ PP.space ~indent:1 f;
+ PP.start_group f 0;
+ statement f s;
+ PP.end_group f;
+ PP.break f;
+ PP.string f "while";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ last_semi();
+ PP.end_group f;
+ PP.end_group f
+ | For_statement (e1, e2, e3, s, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.string f "for";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ (match e1 with
+ | Left e -> opt_expression 0 f e
+ | Right l -> variable_declaration_list false f l);
+ PP.string f ";"; PP.break f;
+ opt_expression 0 f e2;
+ PP.string f ";"; PP.break f;
+ opt_expression 0 f e3;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 0;
+ statement ~last f s;
+ PP.end_group f;
+ PP.end_group f
+ | ForIn_statement (e1, e2, s, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.string f "for";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ (match e1 with
+ | Left e -> expression 0 f e
+ | Right v -> variable_declaration_list false f [v]);
+ PP.space f;
+ PP.string f "in"; PP.break f;
+ PP.space f;
+ expression 0 f e2;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 0;
+ statement ~last f s;
+ PP.end_group f;
+ PP.end_group f
+ | Continue_statement (None,pc) ->
+ output_debug_info f pc;
+ PP.string f "continue";
+ last_semi()
+ | Continue_statement (Some s, pc) ->
+ output_debug_info f pc;
+ PP.string f "continue ";
+ PP.string f (Javascript.Label.to_string s);
+ last_semi()
+ | Break_statement (None, pc) ->
+ output_debug_info f pc;
+ PP.string f "break";
+ last_semi()
+ | Break_statement (Some s, pc) ->
+ output_debug_info f pc;
+ PP.string f "break ";
+ PP.string f (Javascript.Label.to_string s);
+ last_semi()
+ | Return_statement (e,pc) ->
+ output_debug_info f pc;
+ begin match e with
+ None ->
+ PP.string f "return";
+ last_semi()
+ | Some (EFun (i, l, b, pc)) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.start_group f 0;
+ PP.string f "return function";
+ opt_identifier f i;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ formal_parameter_list f l;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "{";
+ function_body f b;
+ PP.string f "}";
+ last_semi();
+ PP.end_group f;
+ PP.end_group f
+ | Some e ->
+ PP.start_group f 7;
+ PP.string f "return";
+ PP.non_breaking_space f;
+ PP.start_group f 0;
+ expression 0 f e;
+ last_semi();
+ PP.end_group f;
+ PP.end_group f
+ (* There MUST be a space between the return and its
+ argument. A line return will not work *)
+ end
+ | Labelled_statement (i, s, pc) ->
+ output_debug_info f pc;
+ PP.string f (Javascript.Label.to_string i);
+ PP.string f ":";
+ PP.break f;
+ statement ~last f s
+ | Switch_statement (e, cc, def, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.string f "switch";
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ expression 0 f e;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "{";
+ let output_one last (e,sl) =
PP.start_group f 1;
- PP.string f "(";
- formal_parameter_list f l;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
PP.start_group f 1;
- PP.string f "{";
- function_body f b;
- PP.string f "};";
- PP.end_group f;
- PP.end_group f
- | Some e ->
- PP.start_group f 7;
- PP.string f "return ";
- PP.start_group f 0;
+ PP.string f "case";
+ PP.space f;
expression 0 f e;
- PP.string f ";";
+ PP.string f ":";
PP.end_group f;
- PP.end_group f
- (* There MUST be a space between the return and its
- argument. A line return will not work *)
- end
- | Labelled_statement (i, s) ->
- PP.string f i;
- PP.string f ":";
- PP.break f;
- statement f s
- | Switch_statement (e, cc, def) ->
- PP.start_group f 1;
- PP.start_group f 0;
- PP.string f "switch";
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- expression 0 f e;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "{";
- List.iter
- (fun (e, sl) ->
- PP.start_group f 1;
- PP.start_group f 1;
- PP.string f "case";
- PP.space f;
- expression 0 f e;
- PP.string f ":";
- PP.end_group f;
- PP.break f;
- PP.start_group f 0;
- statement_list f sl;
- PP.end_group f;
- PP.end_group f;
- PP.break f)
- cc;
- begin match def with
- None ->
- ()
- | Some def ->
- PP.start_group f 1;
- PP.string f "default:";
PP.break f;
PP.start_group f 0;
- statement_list f def;
+ statement_list ~skip_last_semi:(last && def = None) f sl;
PP.end_group f;
- PP.end_group f
- end;
- PP.string f "}";
- PP.end_group f;
- PP.end_group f
- | Throw_statement e ->
- PP.start_group f 6;
- PP.string f "throw ";
- PP.start_group f 0;
- expression 0 f e;
- PP.string f ";";
- PP.end_group f;
- PP.end_group f
- (* There must be a space between the return and its
- argument. A line return would not work *)
- | Try_statement (b, ctch, fin, pc) ->
- output_debug_info f pc;
- PP.start_group f 0;
- PP.string f "try";
- PP.genbreak f " " 1;
- block f b;
- begin match ctch with
- None ->
- ()
- | Some (i, b) ->
- PP.break f;
- PP.start_group f 1;
- PP.string f "catch(";
- PP.string f i;
- PP.string f ")";
- PP.break f;
- block f b;
- PP.end_group f
- end;
- begin match fin with
- None ->
- ()
- | Some b ->
- PP.break f;
- PP.start_group f 1;
- PP.string f "finally";
- PP.space f;
- block f b;
- PP.end_group f
- end;
- PP.end_group f
+ PP.end_group f;
+ PP.break f in
+ let rec loop = function
+ | [] -> ()
+ | [x] -> output_one true x
+ | x::xs -> output_one false x; loop xs in
+ loop cc;
+ begin match def with
+ None ->
+ ()
+ | Some def ->
+ PP.start_group f 1;
+ PP.string f "default:";
+ PP.break f;
+ PP.start_group f 0;
+ statement_list ~skip_last_semi:true f def;
+ PP.end_group f;
+ PP.end_group f
+ end;
+ PP.string f "}";
+ PP.end_group f;
+ PP.end_group f
+ | Throw_statement (e,pc) ->
+ output_debug_info f pc;
+ PP.start_group f 6;
+ PP.string f "throw";
+ PP.non_breaking_space f;
+ PP.start_group f 0;
+ expression 0 f e;
+ last_semi();
+ PP.end_group f;
+ PP.end_group f
+ (* There must be a space between the return and its
+ argument. A line return would not work *)
+ | Try_statement (b, ctch, fin, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 0;
+ PP.string f "try";
+ PP.space ~indent:1 f;
+ block f b;
+ begin match ctch with
+ None ->
+ ()
+ | Some (i, b) ->
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "catch(";
+ ident f i;
+ PP.string f ")";
+ PP.break f;
+ block f b;
+ PP.end_group f
+ end;
+ begin match fin with
+ None ->
+ ()
+ | Some b ->
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "finally";
+ PP.space f;
+ block f b;
+ PP.end_group f
+ end;
+ PP.end_group f
-and statement_list f b =
- match b with
- [] -> ()
- | [s] -> statement f s
- | s :: r -> statement f s; PP.break f; statement_list f r
-
-and block f b =
- PP.start_group f 1;
- PP.string f "{";
- statement_list f b;
- PP.string f "}";
- PP.end_group f
-
-and source_element f se =
- match se with
- Statement s ->
- statement f s
- | Function_declaration (i, l, b, pc) ->
- output_debug_info f pc;
- PP.start_group f 1;
- PP.start_group f 0;
- PP.start_group f 0;
- PP.string f "function";
- PP.space f;
- PP.string f i;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "(";
- formal_parameter_list f l;
- PP.string f ")";
- PP.end_group f;
- PP.end_group f;
- PP.break f;
- PP.start_group f 1;
- PP.string f "{";
- function_body f b;
- PP.string f "}";
- PP.end_group f;
- PP.end_group f
+ and statement_list f ?skip_last_semi b =
+ match b with
+ [] -> ()
+ | [s] -> statement f ?last:skip_last_semi s
+ | s :: r -> statement f s; PP.break f; statement_list f ?skip_last_semi r
+
+ and block f b =
+ PP.start_group f 1;
+ PP.string f "{";
+ statement_list ~skip_last_semi:true f b;
+ PP.string f "}";
+ PP.end_group f
+
+ and source_element f ?skip_last_semi se =
+ match se with
+ Statement s ->
+ statement f ?last:skip_last_semi s
+ | Function_declaration (i, l, b, pc) ->
+ output_debug_info f pc;
+ PP.start_group f 1;
+ PP.start_group f 0;
+ PP.start_group f 0;
+ PP.string f "function";
+ PP.space f;
+ ident f i;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "(";
+ formal_parameter_list f l;
+ PP.string f ")";
+ PP.end_group f;
+ PP.end_group f;
+ PP.break f;
+ PP.start_group f 1;
+ PP.string f "{";
+ function_body f b;
+ PP.string f "}";
+ PP.end_group f;
+ PP.end_group f
-and source_elements f se =
- match se with
- [] -> ()
- | [s] -> source_element f s
- | s :: r -> source_element f s; PP.break f; source_elements f r
-
-let statement f s dl =
- debug_info := Some dl;
- statement f s
-
-let program f se dl =
- debug_info := Some dl;
- PP.start_group f 0; source_elements f se; PP.end_group f; PP.newline f
+ and source_elements f ?skip_last_semi se =
+ match se with
+ [] -> ()
+ | [s] -> source_element f ?skip_last_semi s
+ | s :: r -> source_element f s; PP.break f; source_elements f ?skip_last_semi r
+
+
+ and program f s =
+ source_elements f s
+
+end
+
+let part_of_ident c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' || c = '$'
+
+let need_space a b =
+ part_of_ident a = part_of_ident b
+
+
+let chop_extension s =
+ try Filename.chop_extension s with Invalid_argument _ -> s
+
+let program f ?source_map dl p =
+ let smo = match source_map with
+ | None -> None
+ | Some (_,sm) -> Some sm in
+ let module O = Make(struct
+ let debug_info = dl
+ let source_map = smo
+ end) in
+ PP.set_needed_space_function f need_space;
+ PP.start_group f 0; O.program f p; PP.end_group f; PP.newline f;
+ (match source_map with
+ | None -> ()
+ | Some (out_file,sm) ->
+
+ let oc = open_out out_file in
+ let pp = Pretty_print.to_out_channel oc in
+ Pretty_print.set_compact pp false;
+
+ let sm =
+ { sm with
+ Source_map.mappings = List.map (fun (pos,m) ->
+ {m with
+ Source_map.gen_line = pos.PP.p_line;
+ Source_map.gen_col = pos.PP.p_col}) !O.temp_mappings} in
+
+ let e = Source_map.expression sm in
+ O.expression 0 pp e;
+ close_out oc;
+
+ PP.newline f;
+ PP.string f (Printf.sprintf "//# sourceMappingURL=%s" out_file));
+ if stats ()
+ then begin
+ let size i =
+ Printf.sprintf "%.2fKo" (float_of_int i /. 1024.) in
+ let percent n d =
+ Printf.sprintf "%.1f%%" (float_of_int n *. 100. /. (float_of_int d)) in
+ let total_s = PP.total f in
+ let string_s = !O.stringsize in
+ Format.eprintf "total size : %s@." (size total_s);
+ Format.eprintf "string size: %s (%s)@." (size string_s) (percent string_s total_s);
+ end
diff -Nru js-of-ocaml-1.4/compiler/js_output.mli js-of-ocaml-2.2/compiler/js_output.mli
--- js-of-ocaml-1.4/compiler/js_output.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_output.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,10 +18,7 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-val statement :
- Pretty_print.t -> Javascript.statement -> Parse_bytecode.debug_loc -> unit
-
val program :
- Pretty_print.t -> Javascript.function_body -> Parse_bytecode.debug_loc -> unit
-
-val set_debug_info : unit -> unit
+ Pretty_print.t ->
+ ?source_map:(string * Source_map.t) ->
+ Parse_bytecode.debug_loc -> Javascript.program -> unit
diff -Nru js-of-ocaml-1.4/compiler/js_parser.mly js-of-ocaml-2.2/compiler/js_parser.mly
--- js-of-ocaml-1.4/compiler/js_parser.mly 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_parser.mly 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,796 @@
+(* Js_of_ocaml compiler *)
+(* Copyright (C) 2013 Hugo Heuzard *)
+
+(* Yoann Padioleau *)
+
+(* Copyright (C) 2010 Facebook *)
+
+(* This library is free software; you can redistribute it and/or *)
+(* modify it under the terms of the GNU Lesser General Public License *)
+(* version 2.1 as published by the Free Software Foundation, with the *)
+(* special exception on linking described in file license.txt. *)
+
+(* This library is distributed in the hope that it will be useful, but *)
+(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *)
+(* license.txt for more details. *)
+
+%{
+(*
+ * src: ocamlyaccified from Marcel Laverdet 'fbjs2' via emacs macros, itself
+ * extracted from the official ECMAscript specification at:
+ * http://www.ecma-international.org/publications/standards/ecma-262.htm
+ *
+ * see also http://en.wikipedia.org/wiki/ECMAScript_syntax
+ *
+ * related work:
+ * - http://marijnhaverbeke.nl/parse-js/, js parser in common lisp
+ * (which has been since ported to javascript by nodejs people)
+ * - jslint
+ *)
+
+module J = Javascript
+open Js_token
+
+let bop op a b= J.EBin(op,a,b)
+let uop op a = J.EUn(op,a)
+let var name = J.S {J.name;J.var=None}
+
+(* this is need to fake menhir while using --infer *)
+let _tok = EOF Parse_info.zero
+
+%}
+
+/*(*************************************************************************)*/
+/*(*1 Tokens *)*/
+/*(*************************************************************************)*/
+
+/*(*-----------------------------------------*)*/
+/*(*2 the normal tokens *)*/
+/*(*-----------------------------------------*)*/
+
+/*(* tokens with a value *)*/
+%token T_NUMBER
+%token T_IDENTIFIER
+%token T_STRING
+%token T_REGEX
+
+/*(* keywords tokens *)*/
+%token
+ T_FUNCTION T_IF T_RETURN T_SWITCH T_THIS T_THROW T_TRY
+ T_VAR T_WHILE T_WITH T_NULL T_FALSE T_TRUE
+ T_BREAK T_CASE T_CATCH T_CONTINUE T_DEFAULT T_DO T_FINALLY T_FOR
+ T_DEBUGGER
+
+%token T_ELSE
+
+%token T_NEW
+
+/*(* syntax *)*/
+%token
+ T_LCURLY T_RCURLY
+ T_LPAREN T_RPAREN
+ T_LBRACKET T_RBRACKET
+ T_SEMICOLON
+ T_COMMA
+ T_PERIOD
+
+/*(* operators *)*/
+%token
+ T_RSHIFT3_ASSIGN T_RSHIFT_ASSIGN T_LSHIFT_ASSIGN
+ T_BIT_XOR_ASSIGN T_BIT_OR_ASSIGN T_BIT_AND_ASSIGN T_MOD_ASSIGN T_DIV_ASSIGN
+ T_MULT_ASSIGN T_MINUS_ASSIGN T_PLUS_ASSIGN T_ASSIGN
+
+%token
+ T_PLING T_COLON
+ T_OR
+ T_AND
+ T_BIT_OR
+ T_BIT_XOR
+ T_BIT_AND
+ T_EQUAL T_NOT_EQUAL T_STRICT_EQUAL T_STRICT_NOT_EQUAL
+ T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN
+ T_IN T_INSTANCEOF
+ T_LSHIFT T_RSHIFT T_RSHIFT3
+ T_PLUS T_MINUS
+ T_DIV T_MULT T_MOD
+ T_NOT T_BIT_NOT T_INCR T_DECR T_INCR_NB T_DECR_NB T_DELETE T_TYPEOF T_VOID
+
+/*(*-----------------------------------------*)*/
+/*(*2 extra tokens: *)*/
+/*(*-----------------------------------------*)*/
+
+%token T_VIRTUAL_SEMICOLON
+
+/*(* classic *)*/
+%token EOF
+
+/*(*-----------------------------------------*)*/
+/*(*2 priorities *)*/
+/*(*-----------------------------------------*)*/
+
+
+/*(* Special if / else associativity*)*/
+%nonassoc p_IF
+%nonassoc T_ELSE
+
+%left T_OR
+%left T_AND
+%left T_BIT_OR
+%left T_BIT_XOR
+%left T_BIT_AND
+%left T_EQUAL T_NOT_EQUAL T_STRICT_EQUAL T_STRICT_NOT_EQUAL
+%left
+ T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN
+ T_IN T_INSTANCEOF
+%left T_LSHIFT T_RSHIFT T_RSHIFT3
+%left T_PLUS T_MINUS
+%left T_DIV T_MULT T_MOD
+%right T_NOT T_BIT_NOT T_INCR T_DECR T_INCR_NB T_DECR_NB T_DELETE T_TYPEOF T_VOID
+
+/*(*************************************************************************)*/
+/*(*1 Rules type declaration *)*/
+/*(*************************************************************************)*/
+
+%start program
+%start standalone_expression
+
+%%
+
+/*(*************************************************************************)*/
+/*(*1 Toplevel *)*/
+/*(*************************************************************************)*/
+
+program:
+ | l=source_elements EOF { l }
+
+standalone_expression:
+ | e=expression EOF {e}
+
+source_element:
+ | s=statement { J.Statement s }
+ | f=function_declaration { J.Function_declaration f }
+
+source_elements:
+ | l=list(source_element) { l }
+/*(*************************************************************************)*/
+/*(*1 statement *)*/
+/*(*************************************************************************)*/
+
+statement_no_semi:
+ | b=block_with_pi { J.Block (fst b, J.Pi (snd b)) }
+ (* this is not allowed but some browsers accept it *)
+ (* | function_declaration { *)
+ (* let var,params,body,_ = $1 in *)
+ (* J.Variable_statement [var,Some (J.EFun((None,params,body),None))]} *)
+
+ | s=if_statement { s }
+ | s=iteration_statement { s }
+ | s=with_statement { s }
+ | s=switch_statement { s }
+ | s=try_statement { s }
+ | s=labeled_statement { s }
+ | s=empty_statement { s }
+
+
+statement_need_semi:
+ | variable_statement { $1 }
+ | expression_statement { $1 }
+ | do_while_statement { $1 }
+ | continue_statement { $1 }
+ | break_statement { $1 }
+ | return_statement { $1 }
+ | throw_statement { $1 }
+ | debugger_statement { $1 }
+
+statement:
+ | s=statement_no_semi {s}
+ | s=statement_need_semi semicolon {s}
+ | s=statement_need_semi {
+ (* 7.9.1 - 1 *)
+ (* When, as the program is parsed from left to right, a token (called the offending token)
+ is encountered that is not allowed by any production of the grammar, then a semicolon
+ is automatically inserted before the offending token if one or more of the following
+ conditions is true:
+ - The offending token is }.
+ - The offending token is separated from the previous
+ token by at least one LineTerminator. *)
+
+ (* 7.9.1 - 2 *)
+ (* When, as the program is parsed from left to right, the end of the input stream of tokens *)
+ (* is encountered and the parser is unable to parse the input token stream as a single *)
+ (* complete ECMAScript Program, then a semicolon is automatically inserted at the end *)
+ (* of the input stream. *)
+
+ (* @@@@@@@@@ HACK @@@@@@@@@@ *)
+ (* menhir internal's *)
+ (* look the current token: *)
+ (* - if it is on another line (linebreak inbetween), accept the statement *)
+ (* - fail otherwise *)
+ (* @@@@@@@@@ HACK @@@@@@@@@@ *)
+
+ match _tok with
+ | EOF _ -> s
+ | T_RCURLY _ -> s
+ | t ->
+ let info = Js_token.info_of_tok t in
+ match info.Parse_info.fol with
+ | Some true -> s
+ | _ -> $syntaxerror
+ }
+
+semicolon:
+ | T_SEMICOLON {}
+ | T_VIRTUAL_SEMICOLON {}
+
+labeled_statement:
+| l=label T_COLON s=statement { J.Labelled_statement (l,s,J.N) }
+
+statement_list:
+ | l=list(statement) {l}
+
+block_with_pi:
+ | l=curly_block(statement_list) { l }
+
+block:
+ | block_with_pi { fst $1 }
+
+variable_statement:
+ | T_VAR separated_nonempty_list(T_COMMA,variable_declaration) { J.Variable_statement $2 }
+
+variable_declaration:
+ | variable option(initializeur) { $1, $2 }
+
+initializeur:
+ | T_ASSIGN assignment_expression { $2, J.Pi $1 }
+
+
+empty_statement:
+ | pi=T_SEMICOLON { J.Empty_statement (J.Pi pi) }
+
+debugger_statement:
+ | pi=T_DEBUGGER { J.Debugger_statement (J.Pi pi) }
+
+expression_statement:
+ | expression_no_statement { J.Expression_statement ($1, J.N) }
+
+
+if_statement:
+ | pi=T_IF T_LPAREN i=expression T_RPAREN t=statement T_ELSE e=statement
+ { J.If_statement (i, t, Some e, J.Pi pi) }
+ | pi=T_IF T_LPAREN i=expression T_RPAREN t=statement %prec p_IF
+ { J.If_statement (i, t, None, J.Pi pi) }
+
+do_while_statement:
+ | pi=T_DO statement T_WHILE T_LPAREN expression T_RPAREN
+ { J.Do_while_statement ($2, $5, J.Pi pi) }
+
+
+iteration_statement:
+ | pi=T_WHILE T_LPAREN expression T_RPAREN statement
+ { J.While_statement ($3, $5, J.Pi pi) }
+ | pi=T_FOR T_LPAREN
+ option(expression_no_in) T_SEMICOLON
+ option(expression) T_SEMICOLON
+ option(expression)
+ T_RPAREN statement
+ { J.For_statement ( J.Left $3, $5, $7, $9, J.Pi pi) }
+ | pi=T_FOR T_LPAREN
+ T_VAR separated_nonempty_list(T_COMMA,variable_declaration_no_in) T_SEMICOLON
+ option(expression) T_SEMICOLON
+ option(expression)
+ T_RPAREN statement
+ {
+ J.For_statement (J.Right($4), $6, $8, $10, J.Pi pi)
+ }
+ | pi=T_FOR T_LPAREN left_hand_side_expression T_IN expression T_RPAREN statement
+ { J.ForIn_statement (J.Left $3,$5,$7,J.Pi pi) }
+ | pi=T_FOR T_LPAREN T_VAR variable_declaration_no_in T_IN expression T_RPAREN
+ statement
+ { J.ForIn_statement ( J.Right $4, $6, $8, J.Pi pi) }
+
+variable_declaration_no_in:
+ | variable option(initializer_no_in) { $1, $2 }
+
+initializer_no_in:
+ | T_ASSIGN assignment_expression_no_in { $2, J.Pi $1 }
+
+
+continue_statement:
+ | pi=T_CONTINUE option(label) { J.Continue_statement ($2,J.Pi pi) }
+
+break_statement:
+ | pi=T_BREAK option(label) { J.Break_statement ($2, J.Pi pi) }
+
+return_statement:
+ | pi=T_RETURN option(expression) { J.Return_statement ($2,J.Pi pi) }
+
+with_statement:
+ | T_WITH T_LPAREN expression T_RPAREN statement { assert false }
+
+switch_statement:
+ | pi=T_SWITCH T_LPAREN e=expression T_RPAREN
+ b=curly_block(
+ pair(list(case_clause),option(default_clause)))
+ {
+ let (l,d) = fst b in
+ J.Switch_statement (e, l, d, J.Pi pi) }
+
+throw_statement:
+ | pi=T_THROW expression { J.Throw_statement ($2,J.Pi pi) }
+
+
+try_statement:
+ | pi=T_TRY block catch option(finally) { J.Try_statement ($2, Some $3, $4,J.Pi pi) }
+ | pi=T_TRY block finally { J.Try_statement ($2, None, Some $3,J.Pi pi) }
+
+
+catch:
+ | T_CATCH T_LPAREN variable T_RPAREN block { $3, $5 }
+
+
+finally:
+ | T_FINALLY block { $2 }
+
+/*(*----------------------------*)*/
+/*(*2 auxillary statements *)*/
+/*(*----------------------------*)*/
+
+case_clause:
+ | T_CASE e=expression T_COLON l=statement_list { e,l }
+
+default_clause:
+ | T_DEFAULT T_COLON l=statement_list { l }
+
+/*(*************************************************************************)*/
+/*(*1 function declaration *)*/
+/*(*************************************************************************)*/
+
+function_declaration:
+ | pi=T_FUNCTION v=variable T_LPAREN args=separated_list(T_COMMA,variable) T_RPAREN
+ b=curly_block(function_body)
+ { v, args, fst b, J.Pi pi }
+
+
+function_expression:
+ | pi=T_FUNCTION v=option(variable) T_LPAREN args=separated_list(T_COMMA,variable) T_RPAREN
+ b=curly_block(function_body)
+ { J.EFun (v, args, fst b, J.Pi pi) }
+
+function_body:
+ | l=source_elements { l }
+
+/*(*************************************************************************)*/
+/*(*1 expression *)*/
+/*(*************************************************************************)*/
+
+expression:
+ | assignment_expression { $1 }
+ | expression T_COMMA assignment_expression { J.ESeq ($1, $3) }
+
+assignment_expression:
+ | conditional_expression { $1 }
+ | left_hand_side_expression assignment_operator assignment_expression
+ { J.EBin ($2, $1, $3) }
+
+assignment_operator:
+ | T_ASSIGN { J.Eq }
+ | T_MULT_ASSIGN { J.StarEq }
+ | T_DIV_ASSIGN { J.SlashEq }
+ | T_MOD_ASSIGN { J.ModEq }
+ | T_PLUS_ASSIGN { J.PlusEq }
+ | T_MINUS_ASSIGN { J.MinusEq }
+ | T_LSHIFT_ASSIGN { J.LslEq }
+ | T_RSHIFT_ASSIGN { J.AsrEq }
+ | T_RSHIFT3_ASSIGN { J.LsrEq }
+ | T_BIT_AND_ASSIGN { J.BandEq }
+ | T_BIT_XOR_ASSIGN { J.BxorEq }
+ | T_BIT_OR_ASSIGN { J.BorEq }
+
+left_hand_side_expression:
+ | new_expression { $1 }
+ | call_expression { $1 }
+
+conditional_expression:
+ | post_in_expression { $1 }
+ | post_in_expression
+ T_PLING assignment_expression
+ T_COLON assignment_expression
+ { J.ECond ($1, $3, $5) }
+
+post_in_expression:
+ | pre_in_expression { $1 }
+ | post_in_expression T_LESS_THAN post_in_expression
+ { bop J.Lt $1 $3 }
+ | post_in_expression T_GREATER_THAN post_in_expression
+ { bop J.Gt $1 $3 }
+ | post_in_expression T_LESS_THAN_EQUAL post_in_expression
+ { bop J.Le $1 $3 }
+ | post_in_expression T_GREATER_THAN_EQUAL post_in_expression
+ { bop J.Ge $1 $3 }
+ | post_in_expression T_INSTANCEOF post_in_expression
+ { bop J.InstanceOf $1 $3 }
+ | post_in_expression T_IN post_in_expression
+ { bop J.In $1 $3 }
+ | post_in_expression T_EQUAL post_in_expression
+ { bop J.EqEq $1 $3 }
+ | post_in_expression T_NOT_EQUAL post_in_expression
+ { bop J.NotEq $1 $3 }
+ | post_in_expression T_STRICT_EQUAL post_in_expression
+ { bop J.EqEqEq $1 $3 }
+ | post_in_expression T_STRICT_NOT_EQUAL post_in_expression
+ { bop J.NotEqEq $1 $3 }
+ | post_in_expression T_BIT_AND post_in_expression
+ { bop J.Band $1 $3 }
+ | post_in_expression T_BIT_XOR post_in_expression
+ { bop J.Bxor $1 $3 }
+ | post_in_expression T_BIT_OR post_in_expression
+ { bop J.Bor $1 $3 }
+ | post_in_expression T_AND post_in_expression
+ { bop J.And $1 $3 }
+ | post_in_expression T_OR post_in_expression
+ { bop J.Or $1 $3 }
+
+pre_in_expression:
+ | left_hand_side_expression
+ { $1 }
+ | pre_in_expression T_INCR_NB
+ { uop J.IncrA $1 }
+ | pre_in_expression T_DECR_NB
+ { uop J.DecrA $1 }
+ | T_DELETE pre_in_expression
+ { uop J.Delete $2 }
+ | T_VOID pre_in_expression
+ { uop J.Void $2 }
+ | T_TYPEOF pre_in_expression
+ { uop J.Typeof $2 }
+ | T_INCR pre_in_expression
+ { uop J.IncrB $2 }
+ | T_INCR_NB pre_in_expression
+ { uop J.IncrB $2 }
+ | T_DECR pre_in_expression
+ { uop J.DecrB $2 }
+ | T_DECR_NB pre_in_expression
+ { uop J.DecrB $2 }
+ | T_PLUS pre_in_expression
+ { uop J.Pl $2 }
+ | T_MINUS pre_in_expression
+ { uop J.Neg $2}
+ | T_BIT_NOT pre_in_expression
+ { uop J.Bnot $2 }
+ | T_NOT pre_in_expression
+ { uop J.Not $2 }
+
+ | pre_in_expression T_MULT pre_in_expression { bop J.Mul $1 $3 }
+ | pre_in_expression T_DIV pre_in_expression { bop J.Div $1 $3 }
+ | pre_in_expression T_MOD pre_in_expression { bop J.Mod $1 $3 }
+ | pre_in_expression T_PLUS pre_in_expression { bop J.Plus $1 $3 }
+ | pre_in_expression T_MINUS pre_in_expression { bop J.Minus $1 $3 }
+ | pre_in_expression T_LSHIFT pre_in_expression { bop J.Lsl $1 $3 }
+ | pre_in_expression T_RSHIFT pre_in_expression { bop J.Asr $1 $3 }
+ | pre_in_expression T_RSHIFT3 pre_in_expression { bop J.Lsr $1 $3 }
+
+call_expression:
+ | member_expression arguments { J.ECall($1, $2) }
+ | call_expression arguments { J.ECall($1, $2) }
+ | call_expression T_LBRACKET expression T_RBRACKET { J.EAccess ($1, $3) }
+ | call_expression T_PERIOD method_name { J.EDot ($1, $3) }
+
+new_expression:
+ | member_expression { $1 }
+ | T_NEW new_expression { J.ENew ($2,None) }
+
+member_expression:
+ | e=primary_expression
+ { e }
+ | e1=member_expression T_LBRACKET e2=expression T_RBRACKET
+ { J.EAccess (e1,e2) }
+ | e1=member_expression T_PERIOD i=field_name
+ { J.EDot(e1,i) }
+ | T_NEW e1=member_expression a=arguments
+ { J.ENew(e1, Some a) }
+
+primary_expression:
+ | p=primary_expression_no_statement { p }
+ | o=object_literal { J.EObj o }
+ | f=function_expression { f }
+
+primary_expression_no_statement:
+ | T_THIS { J.EVar (var "this") }
+ | v=variable { J.EVar v }
+
+ | null_literal { J.EVar (var "null") }
+ | b=boolean_literal { J.EBool b }
+ | n=numeric_literal { J.ENum n }
+ | s=string_literal { J.EStr (s, `Utf8) }
+ /*(* marcel: this isn't an expansion of literal in ECMA-262... mistake? *)*/
+ | r=regex_literal { r }
+ | a=array_literal { a }
+ | T_LPAREN e=expression T_RPAREN { e }
+
+/*(*----------------------------*)*/
+/*(*2 no in *)*/
+/*(*----------------------------*)*/
+expression_no_in:
+ | assignment_expression_no_in { $1 }
+ | expression_no_in T_COMMA assignment_expression_no_in { J.ESeq ($1, $3) }
+
+assignment_expression_no_in:
+ | conditional_expression_no_in { $1 }
+ | left_hand_side_expression assignment_operator assignment_expression_no_in
+ { J.EBin($2,$1,$3) }
+
+conditional_expression_no_in:
+ | post_in_expression_no_in { $1 }
+ | post_in_expression_no_in
+ T_PLING assignment_expression_no_in
+ T_COLON assignment_expression_no_in
+ { J.ECond ($1, $3, $5) }
+
+post_in_expression_no_in:
+ | pre_in_expression { $1 }
+ | post_in_expression_no_in T_LESS_THAN post_in_expression
+ { bop J.Lt $1 $3 }
+ | post_in_expression_no_in T_GREATER_THAN post_in_expression
+ { bop J.Gt $1 $3 }
+ | post_in_expression_no_in T_LESS_THAN_EQUAL post_in_expression
+ { bop J.Le $1 $3 }
+ | post_in_expression_no_in T_GREATER_THAN_EQUAL post_in_expression
+ { bop J.Ge $1 $3 }
+ | post_in_expression_no_in T_INSTANCEOF post_in_expression
+ { bop J.InstanceOf $1 $3 }
+ | post_in_expression_no_in T_EQUAL post_in_expression
+ { bop J.EqEq $1 $3 }
+ | post_in_expression_no_in T_NOT_EQUAL post_in_expression
+ { bop J.NotEq $1 $3 }
+ | post_in_expression_no_in T_STRICT_EQUAL post_in_expression
+ { bop J.EqEqEq $1 $3 }
+ | post_in_expression_no_in T_STRICT_NOT_EQUAL post_in_expression
+ { bop J.NotEqEq $1 $3 }
+ | post_in_expression_no_in T_BIT_AND post_in_expression
+ { bop J.Band $1 $3 }
+ | post_in_expression_no_in T_BIT_XOR post_in_expression
+ { bop J.Bxor $1 $3 }
+ | post_in_expression_no_in T_BIT_OR post_in_expression
+ { bop J.Bor $1 $3 }
+ | post_in_expression_no_in T_AND post_in_expression
+ { bop J.And $1 $3 }
+ | post_in_expression_no_in T_OR post_in_expression
+ { bop J.Or $1 $3 }
+
+/*(*----------------------------*)*/
+/*(*2 (no statement)*)*/
+/*(*----------------------------*)*/
+expression_no_statement:
+ | assignment_expression_no_statement { $1 }
+ | expression_no_statement T_COMMA assignment_expression { J.ESeq($1,$3) }
+
+assignment_expression_no_statement:
+ | conditional_expression_no_statement { $1 }
+ | left_hand_side_expression_no_statement assignment_operator assignment_expression
+ { J.EBin ($2,$1,$3) }
+
+conditional_expression_no_statement:
+ | post_in_expression_no_statement { $1 }
+ | post_in_expression_no_statement
+ T_PLING assignment_expression
+ T_COLON assignment_expression
+ { J.ECond ($1, $3, $5) }
+
+
+post_in_expression_no_statement:
+ | pre_in_expression_no_statement { $1 }
+ | post_in_expression_no_statement T_LESS_THAN post_in_expression
+ { bop J.Lt $1 $3 }
+ | post_in_expression_no_statement T_GREATER_THAN post_in_expression
+ { bop J.Gt $1 $3 }
+ | post_in_expression_no_statement T_LESS_THAN_EQUAL post_in_expression
+ { bop J.Le $1 $3 }
+ | post_in_expression_no_statement T_GREATER_THAN_EQUAL post_in_expression
+ { bop J.Ge $1 $3 }
+ | post_in_expression_no_statement T_INSTANCEOF post_in_expression
+ { bop J.InstanceOf $1 $3 }
+ | post_in_expression_no_statement T_IN post_in_expression
+ { bop J.In $1 $3 }
+ | post_in_expression_no_statement T_EQUAL post_in_expression
+ { bop J.EqEq $1 $3 }
+ | post_in_expression_no_statement T_NOT_EQUAL post_in_expression
+ { bop J.NotEq $1 $3 }
+ | post_in_expression_no_statement T_STRICT_EQUAL post_in_expression
+ { bop J.EqEqEq $1 $3 }
+ | post_in_expression_no_statement T_STRICT_NOT_EQUAL post_in_expression
+ { bop J.NotEqEq $1 $3 }
+ | post_in_expression_no_statement T_BIT_AND post_in_expression
+ { bop J.Band $1 $3 }
+ | post_in_expression_no_statement T_BIT_XOR post_in_expression
+ { bop J.Bxor $1 $3 }
+ | post_in_expression_no_statement T_BIT_OR post_in_expression
+ { bop J.Bor $1 $3 }
+ | post_in_expression_no_statement T_AND post_in_expression
+ { bop J.And $1 $3 }
+ | post_in_expression_no_statement T_OR post_in_expression
+ { bop J.Or $1 $3 }
+
+
+pre_in_expression_no_statement:
+ | left_hand_side_expression_no_statement
+ { $1 }
+ | pre_in_expression_no_statement T_INCR_NB
+ { uop J.IncrA $1 }
+ | pre_in_expression_no_statement T_DECR_NB
+ { uop J.DecrA $1 }
+ | T_DELETE pre_in_expression
+ { uop J.Delete $2 }
+ | T_VOID pre_in_expression
+ { uop J.Void $2 }
+ | T_TYPEOF pre_in_expression
+ { uop J.Typeof $2 }
+ | T_INCR pre_in_expression
+ { uop J.IncrB $2 }
+ | T_INCR_NB pre_in_expression
+ { uop J.IncrB $2 }
+ | T_DECR pre_in_expression
+ { uop J.DecrB $2 }
+ | T_DECR_NB pre_in_expression
+ { uop J.DecrB $2 }
+ | T_PLUS pre_in_expression
+ { uop J.Pl $2 }
+ | T_MINUS pre_in_expression
+ { uop J.Neg $2}
+ | T_BIT_NOT pre_in_expression
+ { uop J.Bnot $2 }
+ | T_NOT pre_in_expression
+ { uop J.Not $2 }
+
+ | pre_in_expression_no_statement T_MULT pre_in_expression { bop J.Mul $1 $3 }
+ | pre_in_expression_no_statement T_DIV pre_in_expression { bop J.Div $1 $3 }
+ | pre_in_expression_no_statement T_MOD pre_in_expression { bop J.Mod $1 $3 }
+ | pre_in_expression_no_statement T_PLUS pre_in_expression { bop J.Plus $1 $3 }
+ | pre_in_expression_no_statement T_MINUS pre_in_expression { bop J.Minus $1 $3 }
+ | pre_in_expression_no_statement T_LSHIFT pre_in_expression { bop J.Lsl $1 $3 }
+ | pre_in_expression_no_statement T_RSHIFT pre_in_expression { bop J.Asr $1 $3 }
+ | pre_in_expression_no_statement T_RSHIFT3 pre_in_expression { bop J.Lsr $1 $3 }
+
+left_hand_side_expression_no_statement:
+ | new_expression_no_statement { $1 }
+ | call_expression_no_statement { $1 }
+
+new_expression_no_statement:
+ | member_expression_no_statement { $1 }
+ | T_NEW new_expression { J.ENew ($2,None) }
+
+call_expression_no_statement:
+ | member_expression_no_statement arguments
+ { J.ECall($1, $2) }
+ | call_expression_no_statement arguments
+ { J.ECall($1, $2) }
+ | call_expression_no_statement T_LBRACKET expression T_RBRACKET
+ { J.EAccess($1, $3) }
+ | call_expression_no_statement T_PERIOD method_name
+ { J.EDot($1,$3) }
+
+member_expression_no_statement:
+ | e=primary_expression_no_statement
+ { e }
+ | e1=member_expression_no_statement T_LBRACKET e2=expression T_RBRACKET
+ { J.EAccess(e1, e2) }
+ | e1=member_expression_no_statement T_PERIOD i=field_name
+ { J.EDot(e1,i) }
+ | T_NEW e=member_expression a=arguments
+ { J.ENew(e,Some a) }
+
+/*(*----------------------------*)*/
+/*(*2 scalar *)*/
+/*(*----------------------------*)*/
+null_literal:
+ | T_NULL { }
+
+boolean_literal:
+ | T_TRUE { true }
+ | T_FALSE { false }
+
+numeric_literal:
+ | T_NUMBER {
+ match $1 with
+ | _,f,_ -> f }
+
+regex_literal:
+ | T_REGEX {
+ let s,_ = $1 in
+ let len = String.length s in
+ let regexp,option =
+ if s.[len - 1] = '/'
+ then String.sub s 1 (len - 2),None
+ else
+ let i = String.rindex s '/' in
+ String.sub s 1 (i - 1),Some (String.sub s (i+1) (len - i - 1))
+ in
+ J.ERegexp (regexp,option) }
+ (* J.ENew(J.EVar (var "RegExp"), Some (List.map (fun s -> J.EStr (s,`Bytes)) args)) } *)
+
+string_literal:
+ | str=T_STRING { let s,_ = str in s}
+
+/*(*----------------------------*)*/
+/*(*2 array *)*/
+/*(*----------------------------*)*/
+
+array_literal:
+ | T_LBRACKET elison T_RBRACKET { J.EArr $2 }
+ | T_LBRACKET T_RBRACKET { J.EArr [] }
+ | T_LBRACKET element_list T_RBRACKET { J.EArr $2 }
+ | T_LBRACKET element_list elison T_RBRACKET { J.EArr ($2 @ $3) }
+
+
+element_list:
+ | elison assignment_expression { $1 @ [Some $2] }
+ | assignment_expression { [Some $1] }
+ | element_list elison assignment_expression { $1 @ $2 @ [Some $3] }
+
+
+
+separated_nonempty_list2(sep,X):
+| x = X { [ x ] }
+| x = X; sep { [ x ] }
+| x = X; sep; xs = separated_nonempty_list2(sep, X) { x :: xs }
+
+object_literal:
+ | curly_block(empty) { [] }
+ | res=curly_block(
+ separated_nonempty_list2(
+ T_COMMA,
+ separated_pair(property_name,T_COLON,assignment_expression)
+ )) { fst res }
+
+empty:
+ | {}
+
+/*(*----------------------------*)*/
+/*(*2 variable *)*/
+/*(*----------------------------*)*/
+
+/*(*----------------------------*)*/
+/*(*2 function call *)*/
+/*(*----------------------------*)*/
+
+arguments:
+ | T_LPAREN l=separated_list(T_COMMA,assignment_expression) T_RPAREN { l }
+
+/*(*----------------------------*)*/
+/*(*2 auxillary bis *)*/
+/*(*----------------------------*)*/
+
+/*(*************************************************************************)*/
+/*(*1 Entities, names *)*/
+/*(*************************************************************************)*/
+identifier:
+ | T_IDENTIFIER { fst $1 }
+
+/*(* should some keywork be allowed for field_name and method_name ??*)*/
+field_name:
+ | T_IDENTIFIER { fst $1 }
+method_name:
+ | T_IDENTIFIER { fst $1 }
+
+variable:
+ | i=identifier { var i }
+
+label:
+ | identifier { J.Label.of_string $1 }
+
+property_name:
+ | i=T_IDENTIFIER { J.PNI (fst i) }
+ | s=string_literal { J.PNS s }
+ | n=numeric_literal { J.PNN n }
+
+/*(*************************************************************************)*/
+/*(*1 xxx_opt, xxx_list *)*/
+/*(*************************************************************************)*/
+
+elison:
+ | T_COMMA { [] }
+ | elison T_COMMA { $1 @ [None] }
+
+
+curly_block(X):
+ | pi=T_LCURLY x=X T_RCURLY {x,pi}
diff -Nru js-of-ocaml-1.4/compiler/js_rename.ml js-of-ocaml-2.2/compiler/js_rename.ml
--- js-of-ocaml-1.4/compiler/js_rename.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_rename.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,175 +0,0 @@
-(* Js_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-(*
-Rename bound variables...
-
-
-Get the set of bound variables
-
-Assign variable in inner functions
-
-Get the set of globally free variables ==> black list
-
-For each locally bound variable, gives it the first value possible
-
-Return set of globally free variables + mark free variable with the
-first possible value
-*)
-
-module StringSet = Util.StringSet
-
-module J = Javascript
-
-(****)
-
-let (>>) x f = f x
-
-let opt_app f x y = match x with None -> y | Some x -> f x y
-
-let rec bound_in_statement st s =
- match st with
- J.Block b ->
- bound_in_block b s
- | J.Variable_statement l ->
- List.fold_right (fun (nm, _) s -> StringSet.add nm s) l s
- | J.Expression_statement _ | J.Continue_statement _ | J.Break_statement _
- | J.Return_statement _ | J.Throw_statement _ ->
- s
- | J.If_statement (_, st1, st2) ->
- s >> bound_in_statement st1 >> opt_app bound_in_statement st2
- | J.Do_while_statement (st, _) | J.While_statement (_, st)
- | J.For_statement (_, _, _, st) ->
- bound_in_statement st s
- | J.Switch_statement (_, l1, l2) ->
- s
- >> List.fold_right (fun (_, b) s -> bound_in_block b s) l1
- >> opt_app bound_in_block l2
- | J.Try_statement (b, h, f) ->
- s
- >> opt_app (fun (_, b) -> bound_in_block b) h
- >> opt_app bound_in_block f
-
-and bound_in_block l s = List.fold_right bound_in_statement l s
-
-let bound_in_function_body l s =
- List.fold_left
- (fun s e ->
- match e with
- J.Function_declaration (nm, _, _) ->
- StringSet.add nm s
- | J.Statement st ->
- bound_in_statement st s)
- s l
-
-let bound_in_function (_, l, b) =
- bound_in_function_body b (List.fold_right StringSet.add l StringSet.empty)
-
-(****)
-
-
-let rec expr_fold_closures f e accu =
- match e with
- J.ESeq (e1, e2)
- | J.EBin (_, e1, e2)
- | J.EAccess (e1, e2) ->
- accu >> expr_fold_closures f e1 >> expr_fold_closures f e2
- | J.ECond (e1, e2, e3) ->
- accu
- >> expr_fold_closures f e1
- >> expr_fold_closures f e2
- >> expr_fold_closures f e3
- | J.EUn (_, e1) | J.EDot (e1, _) | J.ENew (e1, None) ->
- expr_fold_closures f e1 accu
- | J.ECall (e1, l) | J.ENew (e1, Some l) ->
- accu >> expr_fold_closures f e1 >>
- List.fold_right (fun e accu -> expr_fold_closures f e accu) l
- | J.EVar _ | J.EStr _ | J.EBool _ | J.ENum _ ->
- accu
- | J.EFun cl ->
- f cl accu
- | J.EArr l ->
- List.fold_right
- (fun e accu -> opt_app (expr_fold_closures f) e accu) l accu
- | J.EObj l ->
- List.fold_right (fun (_, e) accu -> expr_fold_closures f e accu) l accu
- | J.EQuote _ ->
- assert false
-
-(*
-- Allocate variables in inner closures
- ==> subst + constraint on free variables (not in some set)
-*)
-
-
-
-(*
-Use the fact that variables are globally unique
-
-We map an integer to each variable
-*)
-
-(*
-type ctx =
- { subst : int Hashtbl.t;
- bound_vars : StringSet.t;
- mutable next : int }
-
-let rename_statement ctx st free_vars =
- match st with
- J.Block b ->
- rename_block ctx b free_vars
- | J.Variable_statement l ->
- List.fold_left
- (fun free_vars (nm, def) ->
- if not (Hashtbl.mem nm ctx.subst) then begin
- Hashtbl.add nm ctx.next ctx.subst;
- ctx.next <- ctx.next + 1
- end;
- free_vars)
- free_vars l
- | J.Expression_statement _ | J.Continue_statement _ | J.Break_statement _
- | J.Return_statement _ | J.Throw_statement _ ->
- s
- | J.If_statement (_, st1, st2) ->
- s >> bound_in_statement st1 >> opt_app bound_in_statement st2
- | J.Do_while_statement (st, _) | J.While_statement (_, st)
- | J.For_statement (_, _, _, st) ->
- bound_in_statement st s
- | J.Switch_statement (_, l1, l2) ->
- s
- >> List.fold_right (fun (_, b) s -> bound_in_block b s) l1
- >> opt_app bound_in_block l2
- | J.Try_statement (b, h, f) ->
- s
- >> opt_app (fun (_, b) -> bound_in_block b) h
- >> opt_app bound_in_block f
-
-let rec rename_body ctx b =
- let free_vars =
- List.fold_left
- (fun free_vars e ->
- match e with
- J.Function_declaration _ ->
- free_vars (*XXX*)
- | J.Statement st ->
- rename_statement ctx st free_vars)
- StringSet.empty b
-*)
diff -Nru js-of-ocaml-1.4/compiler/js_simpl.ml js-of-ocaml-2.2/compiler/js_simpl.ml
--- js-of-ocaml-1.4/compiler/js_simpl.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_simpl.ml 2014-05-15 08:37:39.000000000 +0000
@@ -20,22 +20,6 @@
module J = Javascript
-let eplus_int e1 e2 =
- match e2,e1 with
- J.ENum n, _ when n < 0. ->
- J.EBin (J.Minus, e1, J.ENum (-. n))
- | _,J.ENum n when n < 0. ->
- J.EBin (J.Minus, e2, J.ENum (-. n))
- | _ ->
- J.EBin (J.Plus, e1, e2)
-
-let eminus_int e1 e2 =
- match e2,e1 with
- J.ENum n,_ when n < 0. ->
- J.EBin (J.Plus, e1, J.ENum (-. n))
- | _ ->
- J.EBin (J.Minus, e1, e2)
-
let rec enot_rec e =
let (_, cost) as res =
match e with
@@ -65,6 +49,8 @@
| J.NotEqEq ->
(J.EBin (J.EqEqEq, e1, e2), 0)
(*Disabled: this is not correct!
+ var x = 0/0;
+ !(x < 0) and x >= 0 give different result
| J.Lt ->
(J.EBin (J.Le, e2, e1), 0)
| J.Le ->
@@ -75,51 +61,31 @@
end
| J.EUn (J.Not, e) ->
(e, 0)
- | J.EUn ((J.Neg | J.Pl | J.Typeof | J.Delete), _) ->
+ | J.EUn ((J.Neg | J.Pl | J.Typeof | J.Void | J.Delete | J.Bnot ), _) ->
(J.EUn (J.Not, e), 0)
+
| J.EBool b ->
(J.EBool (not b), 0)
| J.ECall _ | J.EAccess _ | J.EDot _ | J.ENew _ | J.EVar _ | J.EFun _
- | J.EStr _ | J.EArr _ | J.ENum _ | J.EObj _ | J.EQuote _ ->
- (J.EUn (J.Not, e), 1)
+ | J.EStr _ | J.EArr _ | J.ENum _ | J.EObj _ | J.EQuote _ | J.ERegexp _
+ | J.EUn
+ (( J.IncrA
+ | J.IncrB
+ | J.DecrA
+ | J.DecrB ),_) ->
+ (J.EUn (J.Not, e), 1)
in
if cost <= 1 then res else (J.EUn (J.Not, e), 1)
let enot e = fst (enot_rec e)
-let source_elements l =
- (* FIX: not tail recursive *)
- List.fold_right
- (fun st rem ->
- match st, rem with
- J.Variable_statement [addr, Some (J.EFun ((None, params, body), pc))], _ ->
- J.Function_declaration (addr, params, body, pc) :: rem
- | J.Variable_statement l1,
- J.Statement (J.Variable_statement l2) :: rem' ->
- J.Statement (J.Variable_statement (l1 @ l2)) :: rem'
- | _ ->
- J.Statement st :: rem)
- l []
-
-let statement_list l =
- List.fold_right
- (fun st rem ->
- match st, rem with
- J.Variable_statement l1, J.Variable_statement l2 :: rem' ->
- J.Variable_statement (l1 @ l2) :: rem'
- | _ ->
- st :: rem)
- l []
-
-let block l = match l with [s] -> s | _ -> J.Block (statement_list l)
-
-let unblock st = match st with J.Block l -> l | _ -> [st]
+let unblock st = match st with J.Block (l,_) -> l | _ -> [st]
exception Not_expression
let rec expression_of_statement_list l =
match l with
- J.Return_statement (Some e) :: _ ->
+ J.Return_statement (Some e,_) :: _ ->
e
| J.Expression_statement (e, pc) :: rem ->
J.ESeq (e, expression_of_statement_list rem)
@@ -128,9 +94,9 @@
let expression_of_statement st =
match st with
- J.Return_statement (Some e) -> e
- | J.Block l -> expression_of_statement_list l
- | _ -> raise Not_expression
+ J.Return_statement (Some e,_) -> e
+ | J.Block (l,_) -> expression_of_statement_list l
+ | _ -> raise Not_expression
exception Not_assignment
@@ -139,71 +105,114 @@
[J.Variable_statement [x, Some e]] ->
(x, e)
| J.Expression_statement (e, pc) :: rem ->
- let (x, e') = assignment_of_statement_list rem in
- (x, J.ESeq (e, e'))
+ let (x, (e',nid)) = assignment_of_statement_list rem in
+ (x, (J.ESeq (e, e'),nid))
| _ ->
raise Not_assignment
let assignment_of_statement st =
match st with
J.Variable_statement [x, Some e] -> (x, e)
- | J.Block l -> assignment_of_statement_list l
- | _ -> raise Not_assignment
+ | J.Block (l,_) -> assignment_of_statement_list l
+ | _ -> raise Not_assignment
+
+let simplify_condition = function
+ (* | J.ECond _ -> J.ENum 1. *)
+ | J.ECond (e, J.ENum 1., J.ENum 0.) -> e
+ | J.ECond (e, J.ENum 0., J.ENum 1.) -> J.EUn (J.Not, e)
+ | J.ECond (J.EBin((J.NotEqEq | J.NotEq), J.ENum n, y ),e1,e2)
+ | J.ECond (J.EBin((J.NotEqEq | J.NotEq), y, J.ENum n),e1,e2) ->
+ J.ECond (J.EBin(J.Band,y,J.ENum n),e1,e2)
+ | cond -> cond
-let rec if_statement_2 e iftrue truestop iffalse falsestop =
+let rec if_statement_2 e pc iftrue truestop iffalse falsestop =
+ let e = simplify_condition e in
match iftrue, iffalse with
(* Empty blocks *)
- J.Block [], J.Block [] ->
- [J.Expression_statement (e, None)]
- | J.Block [], _ ->
- if_statement_2 (enot e) iffalse falsestop iftrue truestop
- | _, J.Block [] ->
- [J.If_statement (e, iftrue, None)]
+ J.Block ([],_), J.Block ([],_) ->
+ [J.Expression_statement (e, pc)]
+ | J.Block ([],_), _ ->
+ if_statement_2 (enot e) pc iffalse falsestop iftrue truestop
+ | _, J.Block ([],_) ->
+ [J.If_statement (e, iftrue, None, pc)]
| _ ->
(* Generates conditional *)
begin try
- let (x1, e1) = assignment_of_statement iftrue in
- let (x2, e2) = assignment_of_statement iffalse in
+ let (x1, (e1,_)) = assignment_of_statement iftrue in
+ let (x2, (e2,_)) = assignment_of_statement iffalse in
if x1 <> x2 then raise Not_assignment;
- [J.Variable_statement [x1, Some (J.ECond (e, e1, e2))]]
+ let exp =
+ if e1 = e
+ then J.EBin(J.Or,e,e2)
+ else J.ECond (e, e1, e2) in
+ [J.Variable_statement [x1, Some (exp,pc)]]
with Not_assignment -> try
let e1 = expression_of_statement iftrue in
let e2 = expression_of_statement iffalse in
- [J.Return_statement (Some (J.ECond (e, e1, e2)))]
+ [J.Return_statement (Some (J.ECond (e, e1, e2)), pc)]
with Not_expression ->
if truestop then
- J.If_statement (e, iftrue, None) :: unblock iffalse
+ J.If_statement (e, iftrue, None, pc) :: unblock iffalse
else if falsestop then
- J.If_statement (enot e, iffalse, None) :: unblock iftrue
+ J.If_statement (enot e, iffalse, None, pc) :: unblock iftrue
else
- [J.If_statement (e, iftrue, Some iffalse)]
+ [J.If_statement (e, iftrue, Some iffalse, pc)]
end
-let unopt b = match b with Some b -> b | None -> J.Block []
+let unopt b = match b with Some b -> b | None -> J.Block ([],J.N)
-let rec if_statement e iftrue truestop (iffalse : J.statement) falsestop =
- let e =
- (*FIX: should be done at an earlier stage*)
- match e with
- J.ECond (e, J.ENum 1., J.ENum 0.) -> e
- | _ -> e
- in
+let rec if_statement e ?(pc=J.N) iftrue truestop (iffalse : J.statement) falsestop =
+ (*FIX: should be done at an earlier stage*)
+ let e = simplify_condition e in
match iftrue, iffalse with
(* Shared statements *)
- | J.If_statement (e', iftrue', iffalse'), _
+ | J.If_statement (e', iftrue', iffalse',pc), _
when iffalse = unopt iffalse' ->
- if_statement_2 (J.EBin (J.And, e, e')) iftrue' truestop iffalse falsestop
- | J.If_statement (e', iftrue', iffalse'), _
+ if_statement_2 (J.EBin (J.And, e, e')) pc iftrue' truestop iffalse falsestop
+ | J.If_statement (e', iftrue', iffalse',pc), _
when iffalse = iftrue' ->
- if_statement_2 (J.EBin (J.And, e, J.EUn (J.Not, e')))
+ if_statement_2 (J.EBin (J.And, e, J.EUn (J.Not, e'))) pc
(unopt iffalse') truestop iffalse falsestop
- | _, J.If_statement (e', iftrue', iffalse')
+ | _, J.If_statement (e', iftrue', iffalse',pc)
when iftrue = iftrue' ->
- if_statement_2 (J.EBin (J.Or, e, e'))
+ if_statement_2 (J.EBin (J.Or, e, e')) pc
iftrue truestop (unopt iffalse') falsestop
- | _, J.If_statement (e', iftrue', iffalse')
+ | _, J.If_statement (e', iftrue', iffalse', pc)
when iftrue = unopt iffalse' ->
- if_statement_2 (J.EBin (J.Or, e, (J.EUn (J.Not, e'))))
+ if_statement_2 (J.EBin (J.Or, e, (J.EUn (J.Not, e')))) pc
iftrue truestop iftrue' falsestop
| _ ->
- if_statement_2 e iftrue truestop iffalse falsestop
+ if_statement_2 e pc iftrue truestop iffalse falsestop
+
+
+let rec get_variable acc = function
+ | J.ESeq (e1,e2)
+ | J.EBin (_,e1,e2)
+ | J.EAccess (e1,e2) -> get_variable (get_variable acc e1) e2
+ | J.ECond (e1,e2,e3) ->
+ get_variable (
+ get_variable (
+ get_variable
+ acc
+ e1)
+ e2)
+ e2
+ | J.EUn (_,e1)
+ | J.EDot (e1,_)
+ | J.ENew (e1,None) -> get_variable acc e1
+ | J.ECall (e1,el)
+ | J.ENew (e1,Some el) -> List.fold_left get_variable acc (e1::el)
+ | J.EVar (J.V v) -> Code.VarSet.add v acc
+ | J.EVar (J.S _) -> acc
+ | J.EFun _
+ | J.EStr _
+ | J.EBool _
+ | J.ENum _
+ | J.EQuote _
+ | J.ERegexp _ -> acc
+ | J.EArr a -> List.fold_left (fun acc i ->
+ match i with
+ | None -> acc
+ | Some e1 -> get_variable acc e1) acc a
+ | J.EObj l -> List.fold_left (fun acc (_,e1) ->
+ get_variable acc e1) acc l
diff -Nru js-of-ocaml-1.4/compiler/js_simpl.mli js-of-ocaml-2.2/compiler/js_simpl.mli
--- js-of-ocaml-1.4/compiler/js_simpl.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_simpl.mli 2014-05-15 08:37:39.000000000 +0000
@@ -20,13 +20,6 @@
open Javascript
-val eplus_int : expression -> expression -> expression
-val eminus_int : expression -> expression -> expression
+val if_statement : expression -> ?pc:node_pc -> statement -> bool -> statement -> bool -> statement list
-val source_elements : statement_list -> source_elements
-
-val statement_list : statement_list -> statement_list
-
-val block : statement_list -> statement
-
-val if_statement : expression -> statement -> bool -> statement -> bool -> statement list
+val get_variable : Code.VarSet.t -> expression -> Code.VarSet.t
diff -Nru js-of-ocaml-1.4/compiler/js_tailcall.ml js-of-ocaml-2.2/compiler/js_tailcall.ml
--- js-of-ocaml-1.4/compiler/js_tailcall.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_tailcall.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,187 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Code
+module J = Javascript
+open Js_traverse
+open Javascript
+
+
+class tailcall = object(m)
+ inherit map as super
+
+ val mutable tc = VarSet.empty
+
+ method expression e =
+ match e with
+ | EFun _ -> e
+ | _ -> super#expression e
+
+ method statement s =
+ let s = super#statement s in
+ match s with
+ | Return_statement( Some e,nid ) ->
+ ignore(m#last_e e);
+ s
+ | _ -> s
+
+ method source s =
+ match s with
+ | Function_declaration _ -> s
+ | Statement s -> Statement (m#statement s)
+
+ method get = tc
+
+ method clear = tc <- VarSet.empty
+
+ method private last_e e =
+ match e with
+ | ECall (EVar (V var), args) -> tc <- VarSet.add var tc
+ | ESeq (_,e) -> m#last_e e
+ | ECond (_,e1,e2) -> m#last_e e1;m#last_e e2
+ | _ -> ()
+end
+
+class tailcall_rewrite f = object(m)
+ inherit map as super
+ method expression e =
+ match e with
+ | EFun _ -> e
+ | _ -> super#expression e
+
+ method statement s =
+ let s = super#statement s in
+ match s with
+ | Return_statement(Some e,nid) -> begin match m#last_e e with
+ | None -> s
+ | Some s -> s
+ end
+ | _ -> s
+
+ method private last_e e =
+ match e with
+ | ECall (EVar var,args) -> f var args
+ | ECond (cond,e1,e2) ->
+ let e1' = m#last_e e1 in
+ let e2' = m#last_e e2 in
+ begin match e1',e2' with
+ | None,None -> None
+ | Some s,None ->
+ Some (If_statement(cond,s,Some (Return_statement (Some e2,N)),N))
+ | None,Some s ->
+ Some (If_statement(cond,Return_statement (Some e1,N),Some s,N))
+ | Some s1,Some s2 ->
+ Some (If_statement(cond,s1,Some (s2),N))
+ end
+ | ESeq (e1,e2) ->
+ begin match m#last_e e2 with
+ | None -> None
+ | Some s2 -> Some (Block ([Expression_statement (e1,N);s2],N))
+ end
+ | _ -> None
+ method source s =
+ match s with
+ | Statement st -> Statement (m#statement st)
+ | Function_declaration _ -> s
+
+
+end
+
+
+module type TC = sig
+ val rewrite :
+ (Code.Var.t * Javascript.expression * J.node_pc * VarSet.t) list ->
+ (string -> Javascript.expression) -> Javascript.statement list
+end
+
+module Ident : TC = struct
+ let rewrite closures get_prim =
+ [J.Variable_statement
+ (List.map (fun (name, cl, loc, _) -> J.V name, Some (cl, loc))
+ closures)]
+
+end
+
+module While : TC = struct
+ let rewrite closures get_prim = failwith "todo"
+end
+
+module Tramp : TC = struct
+
+ let rewrite cls get_prim =
+ match cls with
+ | [x,cl,_,req_tc] when not (VarSet.mem x req_tc) ->
+ Ident.rewrite cls get_prim
+ | _ ->
+ let counter = Var.fresh () in
+ Var.name counter "counter";
+ let m2old,m2new = List.fold_right (fun (v,_,_,_) (m2old,m2new) ->
+ let v' = Var.fork v in
+ VarMap.add v' v m2old, VarMap.add v v' m2new
+ ) cls (VarMap.empty,VarMap.empty)in
+ let rewrite v args =
+ try
+ match v with
+ | J.S _ -> None
+ | J.V v ->
+ let n = J.V (VarMap.find v m2new) in
+ let st = J.Return_statement (
+ Some (
+ J.ECond (
+ J.EBin (J.Lt,
+ J.EVar (J.V counter),
+ J.ENum (float_of_int (Option.Tailcall.maximum()))),
+ J.ECall(J.EVar n, J.EBin (J.Plus,J.ENum 1.,J.EVar (J.V counter)) :: args),
+ J.ECall (
+ get_prim "caml_trampoline_return",
+ [J.EVar n ; J.EArr (List.map (fun x -> Some x) (J.ENum 0. :: args))]
+ ))),J.N)
+ in Some st
+ with Not_found -> None
+ in
+ let rw = new tailcall_rewrite rewrite in
+ let wrappers = List.map (fun (v,clo,_,_) ->
+ match clo with
+ | J.EFun (_, args, _, nid) ->
+ let b = J.ECall(
+ get_prim "caml_trampoline",
+ [J.ECall(J.EVar (J.V (VarMap.find v m2new)), J.ENum 0. :: List.map (fun i -> J.EVar i) args)]) in
+ let b = J.Statement (J.Return_statement (Some b,J.N)) in
+ v,J.EFun (None, args,[b],nid )
+ | _ -> assert false) cls in
+ let reals = List.map (fun (v,clo,_,_) ->
+ VarMap.find v m2new,
+ match clo with
+ | J.EFun (nm,args,body,nid) ->
+ J.EFun (nm,(J.V counter)::args,rw#sources body, nid)
+ | _ -> assert false
+ ) cls in
+ let make binds =
+ [J.Variable_statement
+ (List.map (fun (name, ex) -> J.V (name), Some (ex, J.N)) binds)] in
+ make (reals@wrappers)
+
+end
+
+let rewrite l =
+ let open Option.Tailcall in
+ match get () with
+ | TcNone -> Ident.rewrite l
+ | TcTrampoline -> Tramp.rewrite l
+ | TcWhile -> While.rewrite l
diff -Nru js-of-ocaml-1.4/compiler/js_tailcall.mli js-of-ocaml-2.2/compiler/js_tailcall.mli
--- js-of-ocaml-1.4/compiler/js_tailcall.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_tailcall.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,29 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+class tailcall : object
+ inherit Js_traverse.mapper
+ method clear : unit
+ method get : Code.VarSet.t
+end
+
+val rewrite :
+ (Code.Var.t * Javascript.expression * Javascript.node_pc * Code.VarSet.t)
+ list ->
+ (string -> Javascript.expression) -> Javascript.statement list
diff -Nru js-of-ocaml-1.4/compiler/js_token.ml js-of-ocaml-2.2/compiler/js_token.ml
--- js-of-ocaml-1.4/compiler/js_token.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_token.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,294 @@
+
+
+type token =
+ | T_WITH of Parse_info.t
+ | T_WHILE of Parse_info.t
+ | T_VOID of Parse_info.t
+ | T_VIRTUAL_SEMICOLON of Parse_info.t
+ | T_VAR of Parse_info.t
+ | T_TYPEOF of Parse_info.t
+ | T_TRY of Parse_info.t
+ | T_TRUE of Parse_info.t
+ | T_THROW of Parse_info.t
+ | T_THIS of Parse_info.t
+ | T_SWITCH of Parse_info.t
+ | T_STRING of (string * Parse_info.t)
+ | T_STRICT_NOT_EQUAL of Parse_info.t
+ | T_STRICT_EQUAL of Parse_info.t
+ | T_SEMICOLON of Parse_info.t
+ | T_RSHIFT_ASSIGN of Parse_info.t
+ | T_RSHIFT3_ASSIGN of Parse_info.t
+ | T_RSHIFT3 of Parse_info.t
+ | T_RSHIFT of Parse_info.t
+ | T_RPAREN of Parse_info.t
+ | T_RETURN of Parse_info.t
+ | T_REGEX of (string * Parse_info.t)
+ | T_RCURLY of Parse_info.t
+ | T_RBRACKET of Parse_info.t
+ | T_PLUS_ASSIGN of Parse_info.t
+ | T_PLUS of Parse_info.t
+ | T_PLING of Parse_info.t
+ | T_PERIOD of Parse_info.t
+ | T_OR of Parse_info.t
+ | T_NUMBER of (string * float * Parse_info.t)
+ | T_NULL of Parse_info.t
+ | T_NOT_EQUAL of Parse_info.t
+ | T_NOT of Parse_info.t
+ | T_NEW of Parse_info.t
+ | T_MULT_ASSIGN of Parse_info.t
+ | T_MULT of Parse_info.t
+ | T_MOD_ASSIGN of Parse_info.t
+ | T_MOD of Parse_info.t
+ | T_MINUS_ASSIGN of Parse_info.t
+ | T_MINUS of Parse_info.t
+ | T_LSHIFT_ASSIGN of Parse_info.t
+ | T_LSHIFT of Parse_info.t
+ | T_LPAREN of Parse_info.t
+ | T_LESS_THAN_EQUAL of Parse_info.t
+ | T_LESS_THAN of Parse_info.t
+ | T_LCURLY of Parse_info.t
+ | T_LBRACKET of Parse_info.t
+ | T_INSTANCEOF of Parse_info.t
+ | T_INCR_NB of Parse_info.t
+ | T_INCR of Parse_info.t
+ | T_IN of Parse_info.t
+ | T_IF of Parse_info.t
+ | T_IDENTIFIER of (string * Parse_info.t)
+ | T_GREATER_THAN_EQUAL of Parse_info.t
+ | T_GREATER_THAN of Parse_info.t
+ | T_FUNCTION of Parse_info.t
+ | T_FOR of Parse_info.t
+ | T_FINALLY of Parse_info.t
+ | T_FALSE of Parse_info.t
+ | T_EQUAL of Parse_info.t
+ | T_ELSE of Parse_info.t
+ | T_DO of Parse_info.t
+ | T_DIV_ASSIGN of Parse_info.t
+ | T_DIV of Parse_info.t
+ | T_DELETE of Parse_info.t
+ | T_DEFAULT of Parse_info.t
+ | T_DECR_NB of Parse_info.t
+ | T_DECR of Parse_info.t
+ | T_CONTINUE of Parse_info.t
+ | T_COMMA of Parse_info.t
+ | T_COLON of Parse_info.t
+ | T_CATCH of Parse_info.t
+ | T_CASE of Parse_info.t
+ | T_BREAK of Parse_info.t
+ | T_BIT_XOR_ASSIGN of Parse_info.t
+ | T_BIT_XOR of Parse_info.t
+ | T_BIT_OR_ASSIGN of Parse_info.t
+ | T_BIT_OR of Parse_info.t
+ | T_BIT_NOT of Parse_info.t
+ | T_BIT_AND_ASSIGN of Parse_info.t
+ | T_BIT_AND of Parse_info.t
+ | T_ASSIGN of Parse_info.t
+ | T_AND of Parse_info.t
+ | T_DEBUGGER of Parse_info.t
+ | TUnknown of Parse_info.t
+ | TCommentSpace of (Parse_info.t * string)
+ | TCommentNewline of (Parse_info.t * string)
+ | TCommentML of (Parse_info.t * string)
+ | TComment of (Parse_info.t * string)
+ | EOF of Parse_info.t
+
+
+
+let info_of_tok = function
+ | TUnknown ii -> ii
+
+ | TCommentSpace (ii,_) -> ii
+ | TCommentNewline (ii,_) -> ii
+ | TComment (ii,_) -> ii
+ | TCommentML (ii,_) -> ii
+ | EOF ii -> ii
+ | T_DEBUGGER ii -> ii
+
+ | T_NUMBER (s, _,ii) -> ii
+ | T_IDENTIFIER (s, ii) -> ii
+ | T_STRING (s, ii) -> ii
+ | T_REGEX (s, ii) -> ii
+
+ | T_FUNCTION ii -> ii
+ | T_IF ii -> ii
+ | T_IN ii -> ii
+ | T_INSTANCEOF ii -> ii
+ | T_RETURN ii -> ii
+ | T_SWITCH ii -> ii
+ | T_THIS ii -> ii
+ | T_THROW ii -> ii
+ | T_TRY ii -> ii
+ | T_VAR ii -> ii
+ | T_WHILE ii -> ii
+ | T_WITH ii -> ii
+ | T_NULL ii -> ii
+ | T_FALSE ii -> ii
+ | T_TRUE ii -> ii
+ | T_BREAK ii -> ii
+ | T_CASE ii -> ii
+ | T_CATCH ii -> ii
+ | T_CONTINUE ii -> ii
+ | T_DEFAULT ii -> ii
+ | T_DO ii -> ii
+ | T_FINALLY ii -> ii
+ | T_FOR ii -> ii
+ | T_ELSE ii -> ii
+ | T_NEW ii -> ii
+ | T_LCURLY ii -> ii
+ | T_RCURLY ii -> ii
+ | T_LPAREN ii -> ii
+ | T_RPAREN ii -> ii
+ | T_LBRACKET ii -> ii
+ | T_RBRACKET ii -> ii
+ | T_SEMICOLON ii -> ii
+ | T_COMMA ii -> ii
+ | T_PERIOD ii -> ii
+ | T_RSHIFT3_ASSIGN ii -> ii
+ | T_RSHIFT_ASSIGN ii -> ii
+ | T_LSHIFT_ASSIGN ii -> ii
+ | T_BIT_XOR_ASSIGN ii -> ii
+ | T_BIT_OR_ASSIGN ii -> ii
+ | T_BIT_AND_ASSIGN ii -> ii
+ | T_MOD_ASSIGN ii -> ii
+ | T_DIV_ASSIGN ii -> ii
+ | T_MULT_ASSIGN ii -> ii
+ | T_MINUS_ASSIGN ii -> ii
+ | T_PLUS_ASSIGN ii -> ii
+ | T_ASSIGN ii -> ii
+ | T_PLING ii -> ii
+ | T_COLON ii -> ii
+ | T_OR ii -> ii
+ | T_AND ii -> ii
+ | T_BIT_OR ii -> ii
+ | T_BIT_XOR ii -> ii
+ | T_BIT_AND ii -> ii
+ | T_EQUAL ii -> ii
+ | T_NOT_EQUAL ii -> ii
+ | T_STRICT_EQUAL ii -> ii
+ | T_STRICT_NOT_EQUAL ii -> ii
+ | T_LESS_THAN_EQUAL ii -> ii
+ | T_GREATER_THAN_EQUAL ii -> ii
+ | T_LESS_THAN ii -> ii
+ | T_GREATER_THAN ii -> ii
+ | T_LSHIFT ii -> ii
+ | T_RSHIFT ii -> ii
+ | T_RSHIFT3 ii -> ii
+ | T_PLUS ii -> ii
+ | T_MINUS ii -> ii
+ | T_DIV ii -> ii
+ | T_MULT ii -> ii
+ | T_MOD ii -> ii
+ | T_NOT ii -> ii
+ | T_BIT_NOT ii -> ii
+ | T_INCR ii -> ii
+ | T_DECR ii -> ii
+ | T_INCR_NB ii -> ii
+ | T_DECR_NB ii -> ii
+ | T_DELETE ii -> ii
+ | T_TYPEOF ii -> ii
+ | T_VOID ii -> ii
+ | T_VIRTUAL_SEMICOLON ii -> ii
+
+
+let string_of_tok = function
+ | TUnknown ii -> "COMMENT"
+
+ | TCommentSpace (ii,_) -> "COMMENT"
+ | TCommentNewline (ii,_) -> "COMMENT"
+ | TComment (ii,_) -> "COMMENT"
+ | TCommentML (ii,_) -> "COMMENT"
+ | EOF ii -> "EOF"
+
+ | T_DEBUGGER ii -> "DEBUGGER"
+
+ | T_NUMBER (s, _,ii) -> "T_NUMBER"
+ | T_IDENTIFIER (s, ii) -> "T_IDENTIFIER"
+ | T_STRING (s, ii) -> "T_STRING"
+ | T_REGEX (s, ii) -> "T_REGEX"
+
+ | T_FUNCTION ii -> " T_FUNCTION"
+ | T_IF ii -> "T_IF"
+ | T_IN ii -> "T_IN"
+ | T_INSTANCEOF ii -> "T_INSTANCEOF"
+ | T_RETURN ii -> "T_RETURN"
+ | T_SWITCH ii -> "T_SWITCH"
+ | T_THIS ii -> "T_THIS"
+ | T_THROW ii -> "T_THROW"
+ | T_TRY ii -> "T_TRY"
+ | T_VAR ii -> "T_VAR"
+ | T_WHILE ii -> "T_WHILE"
+ | T_WITH ii -> "T_WITH"
+ | T_NULL ii -> "T_NULL"
+ | T_FALSE ii -> "T_FALSE"
+ | T_TRUE ii -> "T_TRUE"
+ | T_BREAK ii -> "T_BREAK"
+ | T_CASE ii -> "T_CASE"
+ | T_CATCH ii -> "T_CATCH"
+ | T_CONTINUE ii -> "T_CONTINUE"
+ | T_DEFAULT ii -> "T_DEFAULT"
+ | T_DO ii -> "T_DO"
+ | T_FINALLY ii -> "T_FINALLY"
+ | T_FOR ii -> "T_FOR"
+ | T_ELSE ii -> "T_ELSE"
+ | T_NEW ii -> "T_NEW"
+ | T_LCURLY ii -> "T_LCURLY"
+ | T_RCURLY ii -> "T_RCURLY"
+ | T_LPAREN ii -> "T_LPAREN"
+ | T_RPAREN ii -> "T_RPAREN"
+ | T_LBRACKET ii -> "T_LBRACKET"
+ | T_RBRACKET ii -> "T_RBRACKET"
+ | T_SEMICOLON ii -> "T_SEMICOLON"
+ | T_COMMA ii -> "T_COMMA"
+ | T_PERIOD ii -> "T_PERIOD"
+ | T_RSHIFT3_ASSIGN ii -> "T_RSHIFT3"
+ | T_RSHIFT_ASSIGN ii -> "T_RSHIFT"
+ | T_LSHIFT_ASSIGN ii -> "T_LSHIFT"
+ | T_BIT_XOR_ASSIGN ii -> "T_BIT"
+ | T_BIT_OR_ASSIGN ii -> "T_BIT"
+ | T_BIT_AND_ASSIGN ii -> "T_BIT"
+ | T_MOD_ASSIGN ii -> "T_MOD"
+ | T_DIV_ASSIGN ii -> "T_DIV"
+ | T_MULT_ASSIGN ii -> "T_MULT"
+ | T_MINUS_ASSIGN ii -> "T_MINUS"
+ | T_PLUS_ASSIGN ii -> "T_PLUS"
+ | T_ASSIGN ii -> "T_ASSIGN"
+ | T_PLING ii -> "T_PLING"
+ | T_COLON ii -> "T_COLON"
+ | T_OR ii -> "T_OR"
+ | T_AND ii -> "T_AND"
+ | T_BIT_OR ii -> "T_BIT"
+ | T_BIT_XOR ii -> "T_BIT"
+ | T_BIT_AND ii -> "T_BIT"
+ | T_EQUAL ii -> "T_EQUAL"
+ | T_NOT_EQUAL ii -> "T_NOT"
+ | T_STRICT_EQUAL ii -> "T_STRICT"
+ | T_STRICT_NOT_EQUAL ii -> "T_STRICT"
+ | T_LESS_THAN_EQUAL ii -> "T_LESS"
+ | T_GREATER_THAN_EQUAL ii -> "T_GREATER"
+ | T_LESS_THAN ii -> "T_LESS"
+ | T_GREATER_THAN ii -> "T_GREATER"
+ | T_LSHIFT ii -> "T_LSHIFT"
+ | T_RSHIFT ii -> "T_RSHIFT"
+ | T_RSHIFT3 ii -> "T_RSHIFT3"
+ | T_PLUS ii -> "T_PLUS"
+ | T_MINUS ii -> "T_MINUS"
+ | T_DIV ii -> "T_DIV"
+ | T_MULT ii -> "T_MULT"
+ | T_MOD ii -> "T_MOD"
+ | T_NOT ii -> "T_NOT"
+ | T_BIT_NOT ii -> "T_BIT"
+ | T_INCR ii -> "T_INCR"
+ | T_DECR ii -> "T_DECR"
+ | T_INCR_NB ii -> "T_INCR"
+ | T_DECR_NB ii -> "T_DECR"
+ | T_DELETE ii -> "T_DELETE"
+ | T_TYPEOF ii -> "T_TYPEOF"
+ | T_VOID ii -> "T_VOID"
+ | T_VIRTUAL_SEMICOLON ii -> "T_VIRTUAL"
+
+let is_comment = function
+ | TCommentSpace _
+ | TCommentNewline _
+ | TComment _
+ | TCommentML _ -> true
+ | _ -> false
diff -Nru js-of-ocaml-1.4/compiler/js_token.mli js-of-ocaml-2.2/compiler/js_token.mli
--- js-of-ocaml-1.4/compiler/js_token.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_token.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,96 @@
+
+type token =
+ | T_WITH of (Parse_info.t)
+ | T_WHILE of (Parse_info.t)
+ | T_VOID of (Parse_info.t)
+ | T_VIRTUAL_SEMICOLON of (Parse_info.t)
+ | T_VAR of (Parse_info.t)
+ | T_TYPEOF of (Parse_info.t)
+ | T_TRY of (Parse_info.t)
+ | T_TRUE of (Parse_info.t)
+ | T_THROW of (Parse_info.t)
+ | T_THIS of (Parse_info.t)
+ | T_SWITCH of (Parse_info.t)
+ | T_STRING of (string * Parse_info.t)
+ | T_STRICT_NOT_EQUAL of (Parse_info.t)
+ | T_STRICT_EQUAL of (Parse_info.t)
+ | T_SEMICOLON of (Parse_info.t)
+ | T_RSHIFT_ASSIGN of (Parse_info.t)
+ | T_RSHIFT3_ASSIGN of (Parse_info.t)
+ | T_RSHIFT3 of (Parse_info.t)
+ | T_RSHIFT of (Parse_info.t)
+ | T_RPAREN of (Parse_info.t)
+ | T_RETURN of (Parse_info.t)
+ | T_REGEX of (string * Parse_info.t)
+ | T_RCURLY of (Parse_info.t)
+ | T_RBRACKET of (Parse_info.t)
+ | T_PLUS_ASSIGN of (Parse_info.t)
+ | T_PLUS of (Parse_info.t)
+ | T_PLING of (Parse_info.t)
+ | T_PERIOD of (Parse_info.t)
+ | T_OR of (Parse_info.t)
+ | T_NUMBER of (string * float * Parse_info.t)
+ | T_NULL of (Parse_info.t)
+ | T_NOT_EQUAL of (Parse_info.t)
+ | T_NOT of (Parse_info.t)
+ | T_NEW of (Parse_info.t)
+ | T_MULT_ASSIGN of (Parse_info.t)
+ | T_MULT of (Parse_info.t)
+ | T_MOD_ASSIGN of (Parse_info.t)
+ | T_MOD of (Parse_info.t)
+ | T_MINUS_ASSIGN of (Parse_info.t)
+ | T_MINUS of (Parse_info.t)
+ | T_LSHIFT_ASSIGN of (Parse_info.t)
+ | T_LSHIFT of (Parse_info.t)
+ | T_LPAREN of (Parse_info.t)
+ | T_LESS_THAN_EQUAL of (Parse_info.t)
+ | T_LESS_THAN of (Parse_info.t)
+ | T_LCURLY of (Parse_info.t)
+ | T_LBRACKET of (Parse_info.t)
+ | T_INSTANCEOF of (Parse_info.t)
+ | T_INCR_NB of (Parse_info.t)
+ | T_INCR of (Parse_info.t)
+ | T_IN of (Parse_info.t)
+ | T_IF of (Parse_info.t)
+ | T_IDENTIFIER of (string * Parse_info.t)
+ | T_GREATER_THAN_EQUAL of (Parse_info.t)
+ | T_GREATER_THAN of (Parse_info.t)
+ | T_FUNCTION of (Parse_info.t)
+ | T_FOR of (Parse_info.t)
+ | T_FINALLY of (Parse_info.t)
+ | T_FALSE of (Parse_info.t)
+ | T_EQUAL of (Parse_info.t)
+ | T_ELSE of (Parse_info.t)
+ | T_DO of (Parse_info.t)
+ | T_DIV_ASSIGN of (Parse_info.t)
+ | T_DIV of (Parse_info.t)
+ | T_DELETE of (Parse_info.t)
+ | T_DEFAULT of (Parse_info.t)
+ | T_DECR_NB of (Parse_info.t)
+ | T_DECR of (Parse_info.t)
+ | T_CONTINUE of (Parse_info.t)
+ | T_COMMA of (Parse_info.t)
+ | T_COLON of (Parse_info.t)
+ | T_CATCH of (Parse_info.t)
+ | T_CASE of (Parse_info.t)
+ | T_BREAK of (Parse_info.t)
+ | T_BIT_XOR_ASSIGN of (Parse_info.t)
+ | T_BIT_XOR of (Parse_info.t)
+ | T_BIT_OR_ASSIGN of (Parse_info.t)
+ | T_BIT_OR of (Parse_info.t)
+ | T_BIT_NOT of (Parse_info.t)
+ | T_BIT_AND_ASSIGN of (Parse_info.t)
+ | T_BIT_AND of (Parse_info.t)
+ | T_ASSIGN of (Parse_info.t)
+ | T_AND of (Parse_info.t)
+ | T_DEBUGGER of (Parse_info.t)
+ | TUnknown of (Parse_info.t)
+ | TCommentSpace of (Parse_info.t * string)
+ | TCommentNewline of (Parse_info.t * string)
+ | TCommentML of (Parse_info.t * string)
+ | TComment of (Parse_info.t * string)
+ | EOF of (Parse_info.t)
+
+val info_of_tok : token -> Parse_info.t
+val string_of_tok : token -> string
+val is_comment : token -> bool
diff -Nru js-of-ocaml-1.4/compiler/js_traverse.ml js-of-ocaml-2.2/compiler/js_traverse.ml
--- js-of-ocaml-1.4/compiler/js_traverse.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_traverse.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,791 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Javascript
+
+class type mapper = object
+ method expression : Javascript.expression -> Javascript.expression
+ method expression_o : Javascript.expression option -> Javascript.expression option
+ method initialiser : (Javascript.expression * Javascript.node_pc) -> (Javascript.expression * Javascript.node_pc)
+ method initialiser_o : (Javascript.expression * Javascript.node_pc) option -> (Javascript.expression * Javascript.node_pc) option
+ method statement : Javascript.statement -> Javascript.statement
+ method statement_o : Javascript.statement option -> Javascript.statement option
+ method statements : Javascript.statement list -> Javascript.statement list
+ method source : Javascript.source_element -> Javascript.source_element
+ method sources : Javascript.source_element list -> Javascript.source_element list
+ method ident : Javascript.ident -> Javascript.ident
+ method program : Javascript.program -> Javascript.program
+end
+
+
+(* generic js ast walk/map *)
+class map : mapper = object(m)
+ method ident i = i
+
+ method statements l = List.map m#statement l
+
+ method statement s = match s with
+ | Block (b,pc) -> Block (m#statements b, pc)
+ | Variable_statement l ->
+ Variable_statement (
+ List.map
+ (fun (id, eo) -> m#ident id, m#initialiser_o eo) l)
+ | Empty_statement pc -> Empty_statement pc
+ | Debugger_statement pc -> Debugger_statement pc
+ | Expression_statement (e,nid) ->
+ Expression_statement (m#expression e, nid)
+ | If_statement(e,s,sopt,pc) ->
+ If_statement(m#expression e,
+ m#statement s,
+ m#statement_o sopt, pc)
+ | Do_while_statement (s,e,pc) ->
+ Do_while_statement (m#statement s, m#expression e, pc)
+ | While_statement(e,s, pc) ->
+ While_statement(m#expression e,m#statement s, pc)
+ | For_statement(e1,e2,e3,s,nid) ->
+ let e1 = match e1 with
+ | Left o -> Left(m#expression_o o)
+ | Right l -> Right(List.map (fun (id, eo) -> m#ident id,m#initialiser_o eo) l) in
+ For_statement(
+ e1,
+ m#expression_o e2,
+ m#expression_o e3,
+ m#statement s,
+ nid)
+ | ForIn_statement(e1,e2,s,nid) ->
+ let e1 = match e1 with
+ | Left e -> Left(m#expression e)
+ | Right ((id,e)) -> Right ((m#ident id,m#initialiser_o e)) in
+ ForIn_statement(
+ e1,
+ m#expression e2,
+ m#statement s,
+ nid)
+ | Continue_statement (s,pc) -> Continue_statement (s,pc)
+ | Break_statement (s,pc) -> Break_statement (s,pc)
+ | Return_statement (e,pc) ->
+ Return_statement (m#expression_o e,pc)
+ | Labelled_statement(l,s,pc) -> Labelled_statement(l,m#statement s, pc)
+ | Throw_statement (e,pc) -> Throw_statement (m#expression e, pc)
+ | Switch_statement (e,l,def,pc) ->
+ Switch_statement (
+ m#expression e,
+ List.map (fun (e,s) -> m#expression e, m#statements s) l,
+ (match def with
+ | None -> None
+ | Some l -> Some (m#statements l)),
+ pc)
+ | Try_statement (b,catch,final,nid) ->
+ Try_statement (
+ m#statements b,
+ (match catch with
+ | None -> None
+ | Some (id,b) -> Some (m#ident id, m#statements b)),
+ (match final with
+ | None -> None
+ | Some s -> Some (m#statements s)),
+ nid)
+
+ method statement_o x = match x with
+ | None -> None
+ | Some s -> Some (m#statement s)
+
+ method expression x = match x with
+ | ESeq(e1,e2) -> ESeq(m#expression e1, m#expression e2)
+ | ECond(e1,e2,e3) ->
+ ECond(m#expression e1,m#expression e2,m#expression e3)
+ | EBin(b,e1,e2) ->
+ EBin(b,m#expression e1,m#expression e2)
+ | EUn(b,e1) -> EUn(b,m#expression e1)
+ | ECall(e1,e2) ->
+ ECall(m#expression e1,List.map m#expression e2)
+ | EAccess(e1,e2) ->
+ EAccess(m#expression e1,m#expression e2)
+ | EDot(e1,id) -> EDot(m#expression e1, id)
+ | ENew(e1,Some args) ->
+ ENew(m#expression e1,Some (List.map m#expression args))
+ | ENew(e1,None) ->
+ ENew(m#expression e1,None)
+ | EVar v -> EVar (m#ident v)
+ | EFun (idopt, params, body ,nid) ->
+ let idopt = match idopt with
+ | None -> None
+ | Some i -> Some (m#ident i) in
+ EFun (idopt, List.map m#ident params, m#sources body ,nid)
+ | EArr l ->
+ EArr (List.map (fun x -> m#expression_o x) l)
+ | EObj l ->
+ EObj (List.map (fun (i,e) -> i, m#expression e) l)
+ | (EStr _ as x)
+ | (EBool _ as x)
+ | (ENum _ as x)
+ | (EQuote _ as x)
+ | (ERegexp _ as x) -> x
+
+
+ method expression_o x = match x with
+ | None -> None
+ | Some s -> Some (m#expression s)
+
+ method initialiser (e,pc) = (m#expression e,pc)
+ method initialiser_o x = match x with
+ | None -> None
+ | Some i -> Some (m#initialiser i)
+
+ method source x = match x with
+ | Statement s -> Statement (m#statement s)
+ | Function_declaration(id,params,body,nid) ->
+ Function_declaration(m#ident id, List.map m#ident params, m#sources body,nid)
+
+ method sources x = List.map m#source x
+
+ method program x = m#sources x
+end
+
+(* var substitution *)
+class subst sub = object
+ inherit map
+ method ident x = sub x
+end
+
+let string_replace v f s =
+ let v' = f s in
+ if v = v'
+ then raise Not_found
+ else EVar v'
+
+class replace_expr f = object(m)
+ inherit map as super
+ method expression e = try EVar (f e) with Not_found -> super#expression e
+end
+
+open Util
+
+(* this optimisation should be done at the lowest common scope *)
+class share_constant = object(m)
+ inherit map as super
+
+ val count = Hashtbl.create 17
+
+ method expression e =
+ let e = match e with
+ | EStr (s,`Utf8) when not(Util.has_backslash s) && Util.is_ascii s ->
+ let e = EStr (s,`Bytes) in
+ let n = try Hashtbl.find count e with Not_found -> 0 in
+ Hashtbl.replace count e (n+1);
+ e
+ | EStr (_,_)
+ | ENum _ ->
+ let n = try Hashtbl.find count e with Not_found -> 0 in
+ Hashtbl.replace count e (n+1);
+ e
+ | _ -> e in
+ super#expression e
+
+ method sources l =
+ let revl,_ = List.fold_left (fun (l,prolog) x ->
+ match x with
+ | Statement (Expression_statement (EStr _,_)) when prolog ->
+ x::l,prolog
+ | x -> (m#source x)::l,false
+ ) ([],true) l in
+ List.rev revl
+
+ method program p =
+ let p = super#program p in
+
+ let all = Hashtbl.create 17 in
+ Hashtbl.iter (fun x n ->
+ let shareit = match x with
+ | EStr(s,_) when n > 1 ->
+ if String.length s < 20
+ then Some ("str_"^s)
+ else Some ("str_"^(String.sub s 0 16)^"_abr")
+ | ENum f when n > 1 ->
+ let s = Javascript.string_of_number f in
+ let l = String.length s in
+ if l > 2
+ then Some ("num_"^s)
+ else None
+ | _ -> None in
+ match shareit with
+ | Some name ->
+ let v = Code.Var.fresh () in
+ Code.Var.name v name;
+ Hashtbl.add all x (V v)
+ | _ -> ()
+ ) count ;
+ if Hashtbl.length all = 0
+ then p
+ else
+ let f = Hashtbl.find all in
+ let p = (new replace_expr f)#program p in
+ let all = Hashtbl.fold (fun e v acc ->
+ (v, Some (e,N)) :: acc) all [] in
+ Statement(Variable_statement all):: p
+end
+
+module S = Code.VarSet
+type t = {
+ use_name : StringSet.t;
+ def_name : StringSet.t;
+ def : S.t;
+ use : S.t;
+ count : int Javascript.IdentMap.t ;
+}
+
+let empty = {
+ def = S.empty;
+ use = S.empty;
+ use_name = StringSet.empty;
+ def_name = StringSet.empty;
+ count = Javascript.IdentMap.empty;
+}
+
+(* def/used/free variable *)
+
+class type freevar =
+ object('a)
+ inherit mapper
+ method merge_info : 'a -> unit
+ method block : ?catch:bool -> Javascript.ident list -> unit
+
+ method def_var : Javascript.ident -> unit
+ method use_var : Javascript.ident -> unit
+ method state : t
+ method get_free_name : Util.StringSet.t
+ method get_free : Code.VarSet.t
+ method get_def_name : Util.StringSet.t
+ method get_def : Code.VarSet.t
+ method get_use_name : Util.StringSet.t
+ method get_use : Code.VarSet.t
+ end
+
+class free =
+ object(m : 'test)
+ inherit map as super
+ val level : int = 0
+ val mutable state_ : t = empty
+ method state = state_
+
+ method get_free =
+ S.diff m#state.use m#state.def
+
+ method get_def = m#state.def
+
+ method get_free_name =
+ StringSet.diff m#state.use_name m#state.def_name
+
+ method get_def_name = m#state.def_name
+
+ method get_use_name = m#state.use_name
+ method get_use = m#state.use
+
+ method merge_info from =
+ let free_name = from#get_free_name in
+ let free = from#get_free in
+ let count = IdentMap.fold (fun v k acc ->
+ let n = try IdentMap.find v acc with Not_found -> 0 in
+ IdentMap.add v (k + n) acc
+ ) from#state.count m#state.count in
+ state_ <- { state_ with
+ use_name = StringSet.union state_.use_name free_name;
+ use = S.union state_.use free;
+ count }
+
+ method use_var x =
+ let n = try IdentMap.find x state_.count with Not_found -> 0 in
+ let count = IdentMap.add x (succ n) state_.count in
+ match x with
+ | S {name} ->
+ state_ <- { state_ with use_name = StringSet.add name state_.use_name;count }
+ | V v ->
+ state_ <- { state_ with use = S.add v state_.use;count }
+ method def_var x =
+ let n = try IdentMap.find x state_.count with Not_found -> 0 in
+ let count = IdentMap.add x (succ n) state_.count in
+ match x with
+ | S {name} ->
+ state_ <- { state_ with def_name = StringSet.add name state_.def_name;count }
+ | V v ->
+ state_ <- { state_ with def = S.add v state_.def;count }
+
+ method expression x = match x with
+ | EVar v -> m#use_var v; x
+ | EFun (ident,params,body,nid) ->
+ let tbody = ({< state_ = empty; level = succ level >} :> 'test) in
+ let () = List.iter tbody#def_var params in
+ let body = tbody#sources body in
+ let ident = match ident with
+ | Some (V v) when not(S.mem v tbody#state.use) -> None
+ | Some (S {name})when not(StringSet.mem name tbody#state.use_name) -> None
+ | Some id -> tbody#def_var id;ident
+ | None -> None in
+ tbody#block params;
+ m#merge_info tbody;
+ EFun (ident,params,body,nid)
+ | _ -> super#expression x
+
+ method source x = match x with
+ | Function_declaration (id,params, body, nid) ->
+ let tbody = {< state_ = empty; level = succ level >} in
+ let () = List.iter tbody#def_var params in
+ let body = tbody#sources body in
+ tbody#block params;
+ m#def_var id;
+ m#merge_info tbody;
+ Function_declaration (id,params, body, nid)
+ | _ -> super#source x
+
+ method block ?catch params = ()
+
+
+ method statement x = match x with
+ | Variable_statement l ->
+ let l = List.map (fun (id,eopt) ->
+ m#def_var id;
+ match eopt with
+ | None -> (id,None)
+ | Some (e,pc) ->
+ let e = m#expression e in
+ (id,Some (e,pc))) l in
+ Variable_statement l
+ | For_statement (Right l,e2,e3,s,nid) ->
+ let l = List.map (fun (id,eopt) ->
+ m#def_var id;
+ match eopt with
+ | None -> (id,None)
+ | Some (e,pc) ->
+ let e = m#expression e in
+ (id,Some (e,pc))) l in
+ For_statement (Right l, m#expression_o e2, m#expression_o e3, m#statement s,nid)
+ | ForIn_statement(Right ((id,eopt)),e2,s,nid) ->
+ m#def_var id;
+ let r = match eopt with
+ | None -> (id,None)
+ | Some (e,pc) ->
+ let e = m#expression e in
+ (id,Some (e,pc)) in
+ ForIn_statement(Right r,m#expression e2,m#statement s,nid)
+ | Try_statement (b,w,f,nid) ->
+ let b = m#statements b in
+ let tbody = {< state_ = empty; level = level >} in
+ let w = match w with
+ | None -> None
+ | Some (id,block) ->
+ let block = tbody#statements block in
+ let () = tbody#def_var id in
+ tbody#block ~catch:true [id];
+ (* special merge here *)
+ (* we need to propagate both def and use .. *)
+ (* .. except 'id' because its scope is limitied to 'block' *)
+ let clean set sets = match id with
+ | S {name} -> set,StringSet.remove name sets
+ | V i -> S.remove i set, sets in
+ let def,def_name = clean tbody#state.def tbody#state.def_name in
+ let use,use_name = clean tbody#state.use tbody#state.use_name in
+ let count = IdentMap.fold (fun v k acc ->
+ let n = try IdentMap.find v acc with Not_found -> 0 in
+ IdentMap.add v (k + n) acc
+ ) tbody#state.count m#state.count in
+ state_ <- {
+ use = S.union state_.use use;
+ use_name = StringSet.union state_.use_name use_name;
+ def = S.union state_.def def;
+ def_name = StringSet.union state_.def_name def_name;
+ count};
+ Some (id,block)
+ in
+ let f = match f with
+ | None -> None
+ | Some block -> Some (m#statements block)
+ in
+ Try_statement (b,w,f,nid)
+ | _ -> super#statement x
+ end
+
+
+
+class rename_variable keeps = object(m : 'test)
+ inherit free as super
+
+ val mutable sub_ = new subst (fun x -> x)
+
+ method merge_info from =
+ let h = Hashtbl.create 17 in
+ let _ = StringSet.iter (fun name ->
+ if StringSet.mem name keeps
+ then ()
+ else
+ let v = Code.Var.fresh () in
+ Code.Var.name v name;
+ Hashtbl.add h name v) from#state.def_name in
+ let f = function
+ | (S {name}) when Hashtbl.mem h name -> V (Hashtbl.find h name)
+ | s -> s in
+ sub_ <- new subst f
+
+ (* method block params *)
+
+ method expression x =
+ let x = super#expression x in
+ match x with
+ | EFun _ -> sub_#expression x
+ | _ -> x
+
+ method statement x =
+ let x = super#statement x in
+ match x with
+ | Try_statement (b,w,f,nid) ->
+ let w = match w with
+ | Some(S {name},block) ->
+ let v = Code.Var.fresh () in
+ Code.Var.name v name;
+ let sub = function
+ | S {name=name'} when name' = name -> V v
+ | x -> x in
+ let s = new subst sub in
+ Some(V v ,s#statements block)
+ | x -> x in
+ Try_statement (b,w,f,nid)
+ | _ -> x
+
+
+ method source x =
+ let x = super#source x in
+ match x with
+ | Function_declaration (id,params,body,nid) ->
+ Function_declaration (id,List.map sub_#ident params,sub_#sources body,nid)
+ | _ -> x
+
+end
+
+class compact_vardecl = object(m)
+ inherit free as super
+
+ val mutable exc_ = IdentSet.empty
+ val mutable insert_ = IdentSet.empty
+
+ method exc = exc_
+
+ method private translate l =
+ Util.filter_map (fun (id,eopt) ->
+ match eopt with
+ | None -> None
+ | Some (e,_) -> Some (EBin (Eq,EVar id,e))) l
+
+ method private translate_st l =
+ let l = m#translate l in
+ match l with
+ | [] -> Empty_statement N
+ | x::l -> Expression_statement (List.fold_left (fun acc e -> ESeq(acc,e)) x l,N)
+
+ method private translate_ex l =
+ let l = m#translate l in
+ match l with
+ | [] -> None
+ | x::l -> Some (List.fold_left (fun acc e -> ESeq(acc,e)) x l)
+
+ method private except e = exc_ <- IdentSet.add e exc_
+
+ method statement s =
+ let s = super#statement s in
+ match s with
+ | Variable_statement l -> m#translate_st l
+ | For_statement (Right l,e2,e3,s,nid) ->
+ For_statement (Left (m#translate_ex l), e2, e3, s,nid)
+ | ForIn_statement(Right (id,op),e2,s,nid) ->
+ (match op with
+ | Some _ -> assert false
+ | None -> ());
+ ForIn_statement(Left (EVar id),e2,s,nid)
+ | Try_statement (b,w,f,nid) ->
+ (match w with
+ | None -> ()
+ | Some (id,_) -> m#except id);
+ Try_statement (b,w,f,nid)
+ | s -> s
+
+ method block ?(catch=false) params =
+ List.iter m#except params;
+ super#block params;
+
+ method merge_info from =
+ super#merge_info from;
+ let all = S.fold (fun e acc -> IdentSet.add (V e) acc) from#state.def IdentSet.empty in
+ let all = StringSet.fold (fun e acc -> IdentSet.add (S {name=e;var=None}) acc) from#state.def_name all in
+ insert_ <- IdentSet.diff all from#exc
+
+ method private split x =
+ let rec loop = function
+ | ESeq(e1,e2) -> loop e1 @ loop e2
+ | e -> [e] in
+ loop x
+
+ method private pack all sources =
+ let may_flush rem vars s instr =
+ if vars = []
+ then rem,[],s::instr
+ else rem,[],s::Statement (Variable_statement (List.rev vars))::instr in
+
+ let rem,vars,instr = List.fold_left (fun (rem,vars,instr) s ->
+ match s with
+ | Statement (Expression_statement (e,nid)) -> begin
+ let l = m#split e in
+ List.fold_left (fun (rem,vars,instr) e -> match e with
+ | EBin(Eq,EVar id,exp) when IdentSet.mem id rem ->
+ (IdentSet.remove id rem,(id,Some (exp,N))::vars,instr)
+ | x -> may_flush rem vars (Statement(Expression_statement (x,nid))) instr)
+ (rem,vars,instr) l
+ end
+ | Statement _ as s -> may_flush rem vars s instr
+ | Function_declaration _ as x -> (rem,vars,x::instr)
+ ) (all,[],[]) sources in
+ let instr = match vars with
+ | [] -> (List.rev instr)
+ | d ->
+ let d = Statement (Variable_statement (List.rev d)) in
+ List.rev (d::instr) in
+ let l = IdentSet.fold (fun x acc -> (x,None)::acc) rem [] in
+ match l,instr with
+ | [],_ -> instr
+ | l, (Statement (Variable_statement l')::rest) ->
+ Statement (Variable_statement (List.rev_append l l')) :: rest
+ | l,_ -> (Statement (Variable_statement l))::instr
+
+ method source x =
+ let x = super#source x in
+ match x with
+ | Function_declaration (id,params, body, nid) ->
+ let all = IdentSet.diff insert_ exc_ in
+ let body = m#pack all body in
+ m#except id;
+ Function_declaration (id,params, body, nid)
+ | _ -> x
+
+ method expression x =
+ let x = super#expression x in
+ match x with
+ | EFun (ident,params,body,nid) ->
+ let all = IdentSet.diff insert_ exc_ in
+ let body = m#pack all body in
+ (match ident with
+ | Some id -> m#except id;
+ | None -> ());
+ EFun (ident,params,body,nid)
+ | _ -> x
+
+ method statements l =
+ let l = super#statements l in
+ let l = List.fold_left (fun acc x ->
+ match x with
+ | Expression_statement (e,nid) ->
+ let l = m#split e in
+ let l = List.fold_left (fun acc e -> Expression_statement (e,nid)::acc) acc l in
+ l
+ | x -> x::acc) [] l in
+ List.rev l
+
+end
+
+class clean = object(m)
+ inherit map as super
+
+ method statements l =
+ let rev_append_st x l = match x with
+ | Block (b,_) -> List.rev_append b l
+ | x -> x::l in
+ let l = super#statements l in
+ let vars_rev,instr_rev = List.fold_left (fun (vars_rev,instr_rev) x ->
+ match x with
+ | Variable_statement l -> (List.rev_append l vars_rev,instr_rev)
+ | Empty_statement _
+ | Expression_statement (EVar _, _) -> vars_rev,instr_rev
+ | x when vars_rev = [] -> ([],rev_append_st x instr_rev)
+ | x -> ([],rev_append_st x (Variable_statement (List.rev vars_rev)::instr_rev))
+ ) ([],[]) l in
+ let instr_rev = match vars_rev with
+ | [] -> instr_rev
+ | vars_rev -> Variable_statement (List.rev vars_rev) :: instr_rev
+ in List.rev instr_rev
+
+ method statement s =
+ let s = super#statement s in
+ let b = function
+ | Block ([],nid) -> Empty_statement nid
+ | Block ([x],_) -> x
+ | b -> b in
+ let bopt = function
+ | Some (Block ([],nid)) -> None
+ | Some (Block ([x],nid)) -> Some x
+ | Some b -> Some b
+ | None -> None in
+ match s with
+ | If_statement (if',then',else',nid) -> If_statement (if',b then',bopt else',nid)
+ | Do_while_statement (do',while',nid) -> Do_while_statement (b do',while',nid)
+ | While_statement (cond,st,nid) -> While_statement (cond,b st,nid)
+ | For_statement (p1,p2,p3,st,nid) -> For_statement (p1,p2,p3,b st,nid)
+ | ForIn_statement (param,e,st,n) -> ForIn_statement (param,e,b st,n)
+ | Switch_statement(e,l,Some [],pc) -> Switch_statement(e,l,None,pc)
+ | s -> s
+
+ method sources l =
+ let l = super#sources l in
+ let append_st st_rev sources_rev =
+ let st = m#statements (List.rev st_rev) in
+ let st = List.map (fun s -> Statement s) st in
+ List.rev_append st sources_rev in
+
+ let (st_rev,sources_rev) = List.fold_left (fun (st_rev,sources_rev) x ->
+ match x with
+ | Statement s -> s::st_rev,sources_rev
+ | x when st_rev = [] -> [],x::sources_rev
+ | x -> [],(x::(append_st st_rev sources_rev))
+ ) ([],[]) l in
+ let sources_rev = match st_rev with
+ | [] -> sources_rev
+ | st_rev -> append_st st_rev sources_rev in
+ List.rev sources_rev
+end
+
+let translate_assign_op = function
+ | Div -> SlashEq
+ | Mod -> ModEq
+ | Lsl -> LslEq
+ | Asr -> AsrEq
+ | Lsr -> LsrEq
+ | Band -> BandEq
+ | Bor -> BorEq
+ | Bxor -> BxorEq
+ | Mul -> StarEq
+ | Plus -> PlusEq
+ | Minus -> MinusEq
+ | _ -> assert false
+
+let assign_op = function
+ | (exp,EBin (Plus, exp',exp'')) ->
+ begin
+ match exp=exp',exp=exp'' with
+ | false,false -> None
+ | true, false ->
+ if exp'' = ENum 1.
+ then Some (EUn (IncrB,exp))
+ else Some (EBin (PlusEq,exp,exp''))
+ | false, true ->
+ if exp' = ENum 1.
+ then Some (EUn (IncrB,exp))
+ else Some (EBin (PlusEq,exp,exp'))
+ | true, true ->
+ Some(EBin(StarEq,exp,ENum 2.))
+ end
+ | (exp,EBin (Minus, exp',y)) when exp = exp' ->
+ if y = ENum 1.
+ then Some (EUn (DecrB, exp))
+ else Some (EBin (MinusEq, exp,y))
+ | (exp,EBin (Mul, exp',exp'')) ->
+ begin
+ match exp=exp',exp=exp'' with
+ | false,false -> None
+ | true,_ ->
+ Some (EBin (StarEq, exp,exp''))
+ | _,true ->
+ Some (EBin (StarEq, exp,exp'))
+ end
+ | (exp,EBin (Div | Mod | Lsl | Asr | Lsr | Band | Bxor | Bor as unop, exp',y)) when exp = exp' ->
+ Some (EBin (translate_assign_op unop, exp,y))
+ | _ -> None
+
+class simpl = object(m)
+ inherit map as super
+ method expression e =
+ let e = super#expression e in
+ match e with
+ | EBin (Plus,e1,e2) -> begin
+ match e2,e1 with
+ | ENum n, _ when n < 0. ->
+ EBin (Minus, e1, ENum (-. n))
+ | _,ENum n when n < 0. ->
+ EBin (Minus, e2, ENum (-. n))
+ | _ -> e
+ end
+ | EBin (Minus,e1,e2) -> begin
+ match e2,e1 with
+ | ENum n,_ when n < 0. ->
+ EBin (Plus, e1, ENum (-. n))
+ | _ -> e
+ end
+ | _ -> e
+
+ method statement s =
+ let s = super#statement s in
+ match s with
+ | Block ([x],_) -> x
+ | _ -> s
+
+ method statements s =
+ let s = super#statements s in
+ List.fold_right (fun st rem ->
+ match st with
+ | If_statement(
+ cond,
+ Return_statement (Some e1,_),
+ Some (Return_statement (Some e2,_)), pc) ->
+ Return_statement (Some (ECond(cond,e1,e2)),pc)::rem
+ | If_statement(
+ cond,
+ Expression_statement (EBin(Eq,v1,e1),_),
+ Some (Expression_statement (EBin(Eq,v2,e2),_)), pc) when v1 = v2 ->
+ Expression_statement (EBin(Eq,v1,ECond(cond,e1,e2)),pc)::rem
+
+ | Variable_statement l1 ->
+ let x = List.map (function
+ | (ident,None) -> Variable_statement [(ident,None)]
+ | (ident,Some (exp,pc)) ->
+ match assign_op (EVar ident,exp) with
+ | Some e -> Expression_statement (e,N)
+ | None -> Variable_statement [(ident,Some (exp,pc))]) l1 in
+ x@rem
+ | _ -> st::rem
+ ) s []
+
+
+ method sources l =
+ let l = super#sources l in
+ let append_st st_rev sources_rev =
+ let st = m#statements (List.rev st_rev) in
+ let st = List.map (function
+ | Variable_statement
+ [addr, Some (EFun (None, params, body, pc),pc')] ->
+ Function_declaration (addr, params, body, pc')
+ | s -> Statement s) st in
+ List.rev_append st sources_rev in
+
+ let (st_rev,sources_rev) = List.fold_left (fun (st_rev,sources_rev) x ->
+ match x with
+ | Statement s -> s::st_rev,sources_rev
+ | x when st_rev = [] -> [],x::sources_rev
+ | x -> [],(x::(append_st st_rev sources_rev))
+ ) ([],[]) l in
+ let sources_rev = match st_rev with
+ | [] -> sources_rev
+ | st_rev -> append_st st_rev sources_rev in
+ List.rev sources_rev
+
+
+end
diff -Nru js-of-ocaml-1.4/compiler/js_traverse.mli js-of-ocaml-2.2/compiler/js_traverse.mli
--- js-of-ocaml-1.4/compiler/js_traverse.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/js_traverse.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,80 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+class type mapper = object
+ method expression : Javascript.expression -> Javascript.expression
+ method expression_o : Javascript.expression option -> Javascript.expression option
+ method initialiser : (Javascript.expression * Javascript.node_pc) -> (Javascript.expression * Javascript.node_pc)
+ method initialiser_o : (Javascript.expression * Javascript.node_pc) option -> (Javascript.expression * Javascript.node_pc) option
+ method statement : Javascript.statement -> Javascript.statement
+ method statements : Javascript.statement list -> Javascript.statement list
+ method statement_o : Javascript.statement option -> Javascript.statement option
+ method source : Javascript.source_element -> Javascript.source_element
+ method sources : Javascript.source_element list -> Javascript.source_element list
+ method ident : Javascript.ident -> Javascript.ident
+ method program : Javascript.program -> Javascript.program
+end
+
+class map : mapper
+
+class subst : (Javascript.ident -> Javascript.ident) -> object
+ inherit mapper
+ end
+
+open Util
+
+type t = {
+ use_name : StringSet.t;
+ def_name : StringSet.t;
+ def : Code.VarSet.t;
+ use : Code.VarSet.t;
+ count : int Javascript.IdentMap.t;
+}
+
+
+class type freevar =
+ object('a)
+ inherit mapper
+ method merge_info : 'a -> unit
+ method block : ?catch:bool -> Javascript.ident list -> unit
+
+ method def_var : Javascript.ident -> unit
+ method use_var : Javascript.ident -> unit
+ method state : t
+ method get_free_name : Util.StringSet.t
+ method get_free : Code.VarSet.t
+ method get_def_name : Util.StringSet.t
+ method get_def : Code.VarSet.t
+ method get_use_name : Util.StringSet.t
+ method get_use : Code.VarSet.t
+ end
+
+class free : freevar
+
+class rename_variable : Util.StringSet.t -> freevar
+
+class share_constant : mapper
+
+class compact_vardecl : object('a)
+ inherit free
+ method exc : Javascript.IdentSet.t
+end
+
+class clean : mapper
+class simpl : mapper
diff -Nru js-of-ocaml-1.4/compiler/linker.ml js-of-ocaml-2.2/compiler/linker.ml
--- js-of-ocaml-1.4/compiler/linker.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/linker.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,206 +18,259 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let ws_opt = "[ \t]*"
-let ws = "[ \t]+"
-let ident = "[a-zA-Z$_][a-zA-Z$_0-9]*"
-
-let comment_rx =
- Str.regexp
- (String.concat "\\|"
- [Format.sprintf "^%s$" ws_opt;
- Format.sprintf "^%s//" ws_opt;
- Format.sprintf "^%s/[*]\\([^*]\\|[*]+[^/]\\)*[*]/%s$" ws_opt ws_opt])
-
-let provides_start_rx =
- Str.regexp (Format.sprintf "^//%sProvides:" ws_opt)
-
-let provides_rx =
- Str.regexp (Format.sprintf "^//%sProvides:%s\\(%s\\)\\(%s\\(%s\\)\\)?%s$"
- ws_opt ws_opt ident ws ident ws_opt)
-
-let requires_start_rx =
- Str.regexp (Format.sprintf "^//%sRequires:" ws_opt)
-
-let requires_rx =
- Str.regexp (Format.sprintf "^//%sRequires:%s\\(\\(%s%s,%s\\)*%s\\)%s$"
- ws_opt ws_opt ident ws_opt ws_opt ident ws_opt)
-
-let comma_rx = Str.regexp (Format.sprintf "%s,%s" ws_opt ws_opt)
-
-let error (f, i) s =
- Format.eprintf "%s:%d: error: %s@." f i s;
- exit 1
-
-let read_line ch loc =
- let l = input_line ch in
- if Str.string_match provides_start_rx l 0 then begin
- if not (Str.string_match provides_rx l 0) then
- error loc "malformed provide line";
- `Provides (loc, Str.matched_group 1 l,
- try Str.matched_group 3 l with Not_found -> "mutator")
- end else if Str.string_match requires_start_rx l 0 then begin
- if not (Str.string_match requires_rx l 0) then
- error loc "malformed requirement line";
- `Requires (loc, Str.split comma_rx (Str.matched_group 1 l))
- end else if Str.string_match comment_rx l 0 then
- `Comment
- else
- `Code l
-
-let debug l =
- match l with
- `Provides (_, nm, k) -> Format.eprintf "provides %s (%s)@." nm k
- | `Requires (_, l) -> Format.eprintf "requires";
- List.iter (fun nm -> Format.eprintf " %s" nm) l;
- Format.eprintf "@."
- | `Comment -> Format.eprintf "comment@."
- | `Code _ -> Format.eprintf "code@."
- | `EOF -> Format.eprintf "eof@."
-
-
-let return x cont l = cont x l
-
-let bind x f cont l = x (fun v l -> f v cont l) l
-
-let accept f cont l =
- match l with
- [] ->
- cont None []
- | x :: r ->
- let v = f x in
- if v = None then cont None l else cont v r
-
-let (++) f g =
- bind f (fun v1 -> bind g (fun v2 -> return (v1, v2)))
-
-let rec collect f =
- bind (accept f) (fun v ->
- match v with
- None -> return []
- | Some v -> bind (collect f) (fun r -> return (v :: r)))
-
-let rec repeat f cont l =
- if l = [] then return [] cont l else
- bind f (fun v -> bind (repeat f) (fun r -> return (v :: r))) cont l
-
-let collect_provides l =
- collect (fun l -> match l with `Provides v -> Some v | _ -> None) l
-let collect_requires l =
- collect (fun l -> match l with `Requires v -> Some v | _ -> None) l
+open Util
-let collect_code l =
- collect (fun l -> match l with `Code v -> Some v | _ -> None) l
+let parse_annot loc s =
+ let buf = Lexing.from_string s in
+ try
+ match Annot_parser.annot Annot_lexer.initial buf with
+ | `Requires (_,l) -> Some (`Requires (Some loc,l))
+ | `Provides (_,n,k,ka) -> Some (`Provides (Some loc,n,k,ka))
+ | `Version (_,l) -> Some (`Version (Some loc, l))
+ with
+ | Not_found -> None
+ | exc ->
+ (* Format.eprintf "Not found for %s : %s @." (Printexc.to_string exc) s; *)
+ None
-let (>>) x f = f x
+let error s = Format.kprintf (fun s -> failwith s) s
let parse_file f =
- let ch =
+ let file =
try
- open_in f
- with Sys_error s ->
- Format.eprintf "%s: %s@." Sys.argv.(0) s;
- exit 1
+ match Util.path_require_findlib f with
+ | Some f ->
+ let pkg,f' = match Util.split Filename.dir_sep f with
+ | [] -> assert false
+ | [f] -> "js_of_ocaml",f
+ | pkg::l -> pkg, List.fold_left Filename.concat "" l in
+ Filename.concat (Util.find_pkg_dir pkg) f'
+ | None -> f
+ with
+ | Not_found ->
+ error "cannot find file '%s'. @." f
+ | Sys_error s ->
+ error "%s@." s
in
- let l = ref [] in
- let i = ref 0 in
- begin try
- while true do
- incr i;
- let x = read_line ch (f, !i) in
-(*
- debug x;
-*)
- l := x :: !l
- done
- with End_of_file -> () end;
- close_in ch;
- !l >> List.rev >> List.filter (fun x -> x <> `Comment)
- >> repeat
- (collect_provides ++ collect_requires ++ collect_code)
- (fun info _ -> info)
- >> List.map
- (fun ((prov, req), code) ->
- let req =
- req >> List.map (fun (loc, l) -> List.map (fun r -> (loc, r)) l)
- >> List.flatten
- in
- (prov, req, code))
+
+ let lex = Parse_js.lexer_from_file ~rm_comment:false file in
+ let status,lexs = Parse_js.lexer_fold (fun (status,lexs) t ->
+ match t with
+ | Js_token.TComment (info,str) -> begin
+ match parse_annot info str with
+ | None -> (status,lexs)
+ | Some a ->
+ match status with
+ | `Annot annot -> `Annot (a::annot),lexs
+ | `Code (an,co) -> `Annot [a], ((List.rev an,List.rev co)::lexs)
+ end
+ | _ when Js_token.is_comment t -> (status,lexs)
+ | c -> match status with
+ | `Code (annot,code) -> `Code (annot,c::code),lexs
+ | `Annot (annot) -> `Code(annot,[c]),lexs
+ ) (`Annot [],[]) lex in
+ let lexs = match status with
+ | `Annot _ -> lexs
+ | `Code(annot,code) -> (List.rev annot,List.rev code)::lexs in
+
+ let res = List.rev_map (fun (annot,code) ->
+ let lex = Parse_js.lexer_from_list code in
+ try
+ let code = Parse_js.parse lex in
+ let req,has_provide,versions = List.fold_left (fun (req,has_provide,versions) a -> match a with
+ | `Provides (pi,name,kind,ka) ->
+ req,Some (pi,name,kind,ka),versions
+ | `Requires (_,mn) -> (mn@req),has_provide,versions
+ | `Version (_,l) -> req,has_provide,l::versions
+ ) ([],None,[]) annot in
+ has_provide,req,versions,code
+ with Parse_js.Parsing_error pi ->
+ error "cannot parse file %S (orig:%S from l:%d, c:%d)@."
+ f pi.Parse_info.name pi.Parse_info.line pi.Parse_info.col)
+ lexs in
+ res
+
+let loc pi = match pi with
+ | None -> "unknown location"
+ | Some pi -> Printf.sprintf "%s:%d" pi.Parse_info.name pi.Parse_info.line
+
+class check_and_warn name pi = object(m)
+ inherit Js_traverse.free as super
+ method merge_info from =
+ let def = from#get_def_name in
+ let use = from#get_use_name in
+ let diff = StringSet.diff def use in
+ let diff = StringSet.remove name diff in
+ let diff = StringSet.filter (fun s -> String.length s <> 0 && s.[0] <> '_') diff in
+ if not (StringSet.is_empty diff)
+ then Format.eprintf "WARN unused for primitive %s at %s:@. %s@."
+ name (loc pi) (String.concat ", " (StringSet.elements diff));
+ super#merge_info from
+end
+
+let check_primitive name pi code req =
+ let free =
+ if Option.Optim.warn_unused ()
+ then new check_and_warn name pi
+ else new Js_traverse.free in
+ let _code = free#program code in
+ let freename = free#get_free_name in
+ let freename = List.fold_left (fun freename x -> StringSet.remove x freename) freename req in
+ let freename = StringSet.diff freename Reserved.keyword in
+ let freename = StringSet.diff freename Reserved.provided in
+ let freename = StringSet.remove Option.global_object freename in
+ if not(StringSet.mem name free#get_def_name)
+ then begin
+ Format.eprintf "warning: primitive code does not define value with the expected name: %s (%s)@." name (loc pi)
+ end;
+ if not(StringSet.is_empty freename)
+ then begin
+ Format.eprintf "warning: free variables in primitive code %S (%s)@." name (loc pi);
+ Format.eprintf "vars: %s@." (String.concat ", " (StringSet.elements freename))
+ end
+
+let version_match =
+ List.for_all (fun (op,str) ->
+ op (Util.Version.(compare current (split str))) 0
+ )
+
+type state = {
+ ids : IntSet.t;
+ codes : Javascript.program list ;
+}
let last_code_id = ref 0
let provided = Hashtbl.create 31
+let provided_rev = Hashtbl.create 31
let code_pieces = Hashtbl.create 31
+let always_included = ref []
+
let add_file f =
List.iter
- (fun (prov, req, code) ->
+ (fun (provide,req,versions,code) ->
incr last_code_id;
let id = !last_code_id in
- List.iter
- (fun (loc, nm, kind) ->
- Code.add_reserved_name nm;
- let kind =
- match kind with
- "pure" | "const" -> `Pure
- | "mutable" -> `Mutable
- | "mutator" -> `Mutator
- | _ ->
- error loc (Format.sprintf "invalid primitive kind '%s'" kind)
- in
- Primitive.register nm kind;
- Hashtbl.add provided nm (id, loc))
- prov;
- Hashtbl.add code_pieces id (code, req))
+ let vmatch = match versions with
+ | [] -> true
+ | l -> List.exists version_match l in
+ if vmatch
+ then begin
+ (match provide with
+ | None -> always_included := id :: !always_included
+ | Some (pi,name,kind,ka) ->
+ let module J = Javascript in
+ let rec find = function
+ | [] -> None
+ | J.Function_declaration (J.S{J.name=n},l,_,_)::_ when name=n -> Some(List.length l)
+ | _::rem -> find rem in
+ let arity = find code in
+ Primitive.register name kind ka arity;
+ if Hashtbl.mem provided name
+ then begin
+ let ploc = snd(Hashtbl.find provided name) in
+ Format.eprintf "warning: overriding primitive %S\n old: %s\n new: %s@." name (loc ploc) (loc pi)
+ end;
+
+ Hashtbl.add provided name (id,pi);
+ Hashtbl.add provided_rev id (name,pi);
+ check_primitive name pi code req
+ );
+ Hashtbl.add code_pieces id (code, req)
+ end
+ )
(parse_file f)
-let rec resolve_dep f visited path loc nm =
- let (id, loc) =
+let get_provided () =
+ Hashtbl.fold (fun k _ acc -> StringSet.add k acc) provided StringSet.empty
+
+let check_deps () =
+ let provided = get_provided () in
+ Hashtbl.iter (fun id (code,requires) ->
+ let traverse = new Js_traverse.free in
+ let _js = traverse#program code in
+ let free = traverse#get_free_name in
+ let requires = List.fold_right StringSet.add requires StringSet.empty in
+ let real = StringSet.inter free provided in
+ let missing = StringSet.diff real requires in
+ if not (StringSet.is_empty missing)
+ then begin
+ try
+ let (name,ploc) = Hashtbl.find provided_rev id in
+ Format.eprintf "code providing %s (%s) may miss dependencies: %s\n"
+ name
+ (loc ploc)
+ (String.concat ", " (StringSet.elements missing))
+ with Not_found ->
+ (* there is no //Provides for this piece of code *)
+ (* FIXME handle missing deps in this case *)
+ ()
+ end
+ ) code_pieces
+
+let load_files l =
+ List.iter add_file l;
+ check_deps ()
+
+(* resolve *)
+let rec resolve_dep_name_rev visited path nm =
+ let id =
try
- Hashtbl.find provided nm
+ fst(Hashtbl.find provided nm)
with Not_found ->
- error loc (Format.sprintf "missing dependency '%s'@." nm)
+ error "missing dependency '%s'@." nm
in
- if Util.IntSet.mem id visited then begin
-(* if List.mem_assoc id path then error loc "circular dependency";*)
+ resolve_dep_id_rev visited path id
+
+and resolve_dep_id_rev visited path id =
+ if IntSet.mem id visited.ids then begin
+ if List.memq id path
+ then error "circular dependency: %s" (String.concat ", " (List.map (fun id -> fst(Hashtbl.find provided_rev id)) path));
visited
end else begin
- let visited = Util.IntSet.add id visited in
- let path = (id, loc) :: path in
+ let path = id :: path in
let (code, req) = Hashtbl.find code_pieces id in
+ let visited = {visited with ids = IntSet.add id visited.ids} in
let visited =
List.fold_left
- (fun visited (loc, nm) -> resolve_dep f visited path loc nm)
- visited req
- in
- List.iter (fun s -> Pretty_print.string f s; Pretty_print.newline f) code;
+ (fun visited nm -> resolve_dep_name_rev visited path nm)
+ visited req in
+ let visited = {visited with codes = code::visited.codes} in
visited
end
-let resolve_deps ?(linkall = false) compact f l =
- let (missing, visited) =
- List.fold_left
- (fun (missing, visited) nm ->
- if Hashtbl.mem provided nm then
- (missing, resolve_dep f visited [] ("", -1) nm)
- else
- (nm :: missing, visited))
- ([], Util.IntSet.empty) l
- in
- if linkall then begin
- let visited = ref visited in
- Hashtbl.iter (fun nm (id, loc) ->
- visited := resolve_dep f !visited [] ("", -1) nm
- ) provided;
- end;
- List.rev missing
-(*
-let _ =
- for i = 1 to Array.length Sys.argv - 1 do
- add_file Sys.argv.(i)
- done;
- let missing = ref [] in
- Format.eprintf "%a@."
- (fun f v -> missing := resolve_deps f v) ["caml_array_get"]
-*)
+let init () =
+ List.fold_left
+ (fun visited id -> resolve_dep_id_rev visited [] id)
+ {ids=IntSet.empty; codes=[]} !always_included
+
+let resolve_deps ?(linkall = false) visited_rev used =
+ (* link the special files *)
+ let missing,visited_rev =
+ if linkall
+ then
+ begin
+ (* link all primitives *)
+ let prog,set =
+ Hashtbl.fold (fun nm (id,_) (visited,set) ->
+ resolve_dep_name_rev visited [] nm,
+ StringSet.add nm set
+ )
+ provided
+ (visited_rev,StringSet.empty) in
+ let missing = StringSet.diff used set in
+ missing,prog
+ end
+ else (* link used primitives *)
+ StringSet.fold
+ (fun nm (missing, visited)->
+ if Hashtbl.mem provided nm then
+ (missing, resolve_dep_name_rev visited [] nm)
+ else
+ (StringSet.add nm missing, visited))
+ used (StringSet.empty, visited_rev) in
+ visited_rev, missing
+
+let link program state = List.flatten (List.rev (program::state.codes))
diff -Nru js-of-ocaml-1.4/compiler/linker.mli js-of-ocaml-2.2/compiler/linker.mli
--- js-of-ocaml-1.4/compiler/linker.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/linker.mli 2014-05-15 08:37:39.000000000 +0000
@@ -16,7 +16,18 @@
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
+*)
-val add_file : string -> unit
-val resolve_deps : ?linkall:bool -> bool -> Pretty_print.t -> string list -> string list
+val parse_file : string ->
+ ((Parse_info.t option * string * Primitive.kind * Primitive.kind_arg list option) option * (* provide *)
+ string list * (* require *)
+ ((int -> int -> bool) * string) list list * (* version constraint *)
+ Javascript.program) list
+
+val load_files : string list -> unit
+
+type state
+val init : unit -> state
+val resolve_deps : ?linkall:bool -> state -> Util.StringSet.t -> state * Util.StringSet.t
+val link : Javascript.program -> state -> Javascript.program
+val get_provided : unit -> Util.StringSet.t
diff -Nru js-of-ocaml-1.4/compiler/main.ml js-of-ocaml-2.2/compiler/main.ml
--- js-of-ocaml-1.4/compiler/main.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/main.ml 1970-01-01 00:00:00.000000000 +0000
@@ -1,99 +0,0 @@
-(* Js_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-let debug = Util.debug "main"
-let times = Util.debug "times"
-let linkall = ref false
-
-let f paths js_files input_file output_file =
- let t = Util.Timer.make () in
- List.iter Linker.add_file js_files;
- let paths = List.rev_append paths [Findlib.package_directory "stdlib"] in
- let t1 = Util.Timer.make () in
- let p =
- match input_file with
- None ->
- Parse_bytecode.from_channel ~paths stdin
- | Some f ->
- let ch = open_in_bin f in
- let p = Parse_bytecode.from_channel ~paths ch in
- close_in ch;
- p
- in
- if times () then Format.eprintf " parsing: %a@." Util.Timer.print t1;
- let linkall = !linkall in
- let output_program = Driver.f ~linkall p in
- begin match output_file with
- None ->
- output_program (Pretty_print.to_out_channel stdout)
- | Some f ->
- let ch = open_out_bin f in
- output_program (Pretty_print.to_out_channel ch);
- close_out ch
- end;
- if times () then Format.eprintf "compilation: %a@." Util.Timer.print t
-
-let _ =
- Findlib.init ();
- Util.Timer.init Unix.gettimeofday;
- let js_files = ref [] in
- let output_file = ref None in
- let input_file = ref None in
- let no_runtime = ref false in
- let paths = ref [] in
- let options =
- [("-debug", Arg.String Util.set_debug, " debug module ");
- ("-disable",
- Arg.String Util.set_disabled, " disable optimization ");
- ("-pretty", Arg.Unit Driver.set_pretty, " pretty print the output");
- ("-debuginfo", Arg.Unit Driver.set_debug_info, " output debug info");
- ("-opt", Arg.Int Driver.set_profile, " set optimization profile : o1 (default), o2, o3");
- ("-noinline", Arg.Unit (fun () -> Util.set_disabled "inline"), " disable inlining");
- ("-linkall", Arg.Set linkall, " link all primitives");
- ("-noruntime", Arg.Unit (fun () -> no_runtime := true),
- " do not include the standard runtime");
- ("-toplevel", Arg.Unit Parse_bytecode.build_toplevel,
- " compile a toplevel");
- ("-I", Arg.String (fun s -> paths := s :: !paths),
- " Add to the list of include directories");
- ("-o", Arg.String (fun s -> output_file := Some s),
- " set output file name to ")]
- in
- Arg.parse (Arg.align options)
- (fun s ->
- if Filename.check_suffix s ".js" then
- js_files := s :: !js_files
- else
- input_file := Some s)
- (Format.sprintf "Usage: %s [options]" Sys.argv.(0));
- let runtime =
- if !no_runtime then [] else
- try
- [Filename.concat (Findlib.package_directory "js_of_ocaml") "runtime.js"]
- with Findlib.No_such_package _ ->
- Format.eprintf "%s: runtime file 'runtime.js' not found.@." Sys.argv.(0);
- exit 1
- in
- let chop_extension s =
- try Filename.chop_extension s with Invalid_argument _ -> s in
- f !paths (runtime @ List.rev !js_files) !input_file
- (match !output_file with
- Some _ -> !output_file
- | None -> Util.opt_map (fun s -> chop_extension s ^ ".js") !input_file)
diff -Nru js-of-ocaml-1.4/compiler/Makefile js-of-ocaml-2.2/compiler/Makefile
--- js-of-ocaml-1.4/compiler/Makefile 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/Makefile 2014-05-15 08:37:39.000000000 +0000
@@ -1,46 +1,95 @@
include ../Makefile.conf
-all: $(COMPILER)
+all: $(COMPILER) $(MINIFIER)
-PACKAGES=findlib,str,unix
+lib: compiler.cma compiler.cmxa compiler.cmxs
-OBJS=pretty_print.cmx util.cmx dgraph.cmx \
- javascript.cmx js_output.cmx js_simpl.cmx \
- instr.cmx code.cmx primitive.cmx subst.cmx pure_fun.cmx deadcode.cmx \
- flow.cmx inline.cmx \
+PACKAGES=findlib
+
+OBJS=compiler_version.cmx \
+ pretty_print.cmx util.cmx option.cmx reserved.cmx varPrinter.cmx \
+ dgraph.cmx code.cmx javascript.cmx vlq64.cmx source_map.cmx \
+ js_output.cmx js_simpl.cmx parse_info.cmx js_token.cmx js_parser.cmx \
+ js_lexer.cmx parse_js.cmx annot_parser.cmx annot_lexer.cmx \
+ instr.cmx primitive.cmx subst.cmx pure_fun.cmx deadcode.cmx \
+ flow.cmx specialize.cmx specialize_js.cmx eval.cmx inline.cmx \
tailcall.cmx freevars.cmx phisimpl.cmx \
- linker.cmx generate.cmx parse_bytecode.cmx driver.cmx
+ js_traverse.cmx js_assign.cmx js_tailcall.cmx \
+ linker.cmx generate.cmx parse_bytecode.cmx driver.cmx \
+ pseudoFs.cmx
-COMPOBJS=$(OBJS) main.cmx
+COMPOBJS=$(OBJS) compile.cmx
$(COMPILER): compile.$(BEST)
mv -f $< $@
-.INTERMEDIATE: compile.byte compile.opt
+$(MINIFIER): minify.$(BEST)
+ mv -f $< $@
+
+.INTERMEDIATE: compile.byte compile.opt minify.byte minify.opt
+
compile.byte: $(COMPOBJS:cmx=cmo)
ocamlfind ocamlc -package $(PACKAGES) -linkpkg -o $@ $^
-
compile.opt: $(COMPOBJS)
- ocamlfind ocamlopt -package $(PACKAGES) -linkpkg -o $@ $^
+ ocamlfind ocamlopt -package $(PACKAGES) -linkpkg -g -o $@ $^
+
+minify.byte: $(OBJS:cmx=cmo) minify.cmo
+ ocamlfind ocamlc -package $(PACKAGES) -linkpkg -o $@ $^
+minify.opt: $(OBJS:cmx=cmx) minify.cmx
+ ocamlfind ocamlopt -package $(PACKAGES) -linkpkg -g -o $@ $^
+
compiler.cma: $(OBJS:cmx=cmo)
- ocamlfind ocamlc -a -o $@ $^
+ ocamlfind ocamlc -pack -o $@ $^
+
+local/compiler.cma: compiler.cma
+ mkdir -p local
+ cp compiler.cma compiler.cmi local/
+
+compiler.cmxa: $(OBJS)
+ ocamlfind ocamlopt -pack -g -o $@ $^
+
+compiler.cmxs: $(OBJS)
+ ocamlfind ocamlopt -shared -g -o $@ $^
+
+VERSION := $(shell head -n 1 ../VERSION)
+
+compiler_version.ml: compiler_version.ml.tmp
+ if cmp -s $^ $@; then rm $^; else mv $^ $@; fi
+
+.PHONY: compiler_version.ml.tmp
+compiler_version.ml.tmp:
+ echo "let s = \"${VERSION}\"" > $@
+ echo "let git_version = \"${VERSION_GIT}\"" >> $@
%.cmx: %.ml
- ocamlfind ocamlopt -package findlib,str -c $<
+ ocamlfind ocamlopt -package $(PACKAGES) -for-pack Compiler -g -c $<
%.cmo: %.ml
- ocamlfind ocamlc -package findlib,str -c $<
+ ocamlfind ocamlc -package $(PACKAGES) -c $<
%.cmi: %.mli
- ocamlfind ocamlc -package findlib,str -c $<
+ ocamlfind ocamlc -package $(PACKAGES) -c $<
+
+%.ml %.mli: %.mly
+ menhir --explain $<
+
+js_parser.ml js_parser.mli: js_parser.mly
+ menhir --external-tokens Js_token --explain $<
+%.ml: %.mll
+ ocamllex $<
clean:
- rm -f *.cm[aiox] *.o
- rm -f js_of_ocaml compile.opt compile.byte
+ rm -f *.cm[aiox] *.cmxa *.cmxs *.o *.a *.conflicts
+ rm -f compile.opt compile.byte minify.opt minify.byte
+ rm -f $(MINIFIER) $(COMPILER)
+ rm -f compiler_version.ml
+ rm -f annot_lexer.ml annot_parser.ml annot_parser.mli
+ rm -f js_lexer.ml js_parser.ml js_parser.mli
-depend:
+.PHONY: depend
+depend: compiler_version.ml annot_lexer.ml js_lexer.ml js_parser.ml annot_parser.ml
ocamldep *.ml *.mli > .depend
include .depend
diff -Nru js-of-ocaml-1.4/compiler/minify.ml js-of-ocaml-2.2/compiler/minify.ml
--- js-of-ocaml-1.4/compiler/minify.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/minify.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,138 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+
+let error k = Format.ksprintf (fun s -> failwith s) k
+
+let _ = Sys.catch_break true
+
+let read_file f =
+ let c = open_in f in
+ let out = Buffer.create 1024 in
+ let buf = String.create 1024 in
+ try
+ while true; do
+ let i = input c buf 0 1023 in
+ if i <> 0
+ then Buffer.add_substring out buf 0 i
+ else raise Not_found
+ done;
+ assert false;
+ with Not_found -> Buffer.contents out
+
+let run () =
+ Util.Timer.init Sys.time;
+ let js_files = ref [] in
+ let stdin = ref false in
+ let output_file = ref None in
+ let options =
+ [("-debug", Arg.String Option.Debug.enable, " debug module ");
+ ("-disable",
+ Arg.String Option.Optim.disable, " disable optimization ");
+ ("-pretty", Arg.Unit (fun () -> Option.Optim.enable "pretty"), " pretty print the output");
+ ("-debuginfo", Arg.Unit (fun () -> Option.Optim.enable "debuginfo"), " output debug info");
+ ("-noinline", Arg.Unit (fun () -> Option.Optim.disable "inline"), " disable inlining");
+ ("-stdin", Arg.Set stdin, " read from standard input");
+ ("-o", Arg.String (fun s -> output_file := Some s),
+ " set output file name to ")]
+ in
+
+ let usage_header = (Format.sprintf "Usage: %s [options]" Sys.argv.(0)) in
+
+
+ Arg.parse (Arg.align options)
+ (fun s ->
+ if Filename.check_suffix s ".js" then
+ if Sys.file_exists s
+ then js_files := s :: !js_files
+ else error "file '%s' do not exist" s
+ else
+ error "Don't know what to do with '%s'" s
+ )
+ (usage_header);
+
+ let chop_extension s =
+ try Filename.chop_extension s with Invalid_argument _ -> s in
+
+ let pp,finalize = match !output_file with
+ | Some "-" ->
+ Pretty_print.to_out_channel stdout,(fun _ -> ())
+ | Some file ->
+ let oc = open_out file in
+ Pretty_print.to_out_channel oc, (fun _ -> close_out oc)
+ | None when not(!stdin) && List.length !js_files = 1 ->
+ let file = chop_extension (List.hd !js_files) ^ ".min.js" in
+ let oc = open_out file in
+ Pretty_print.to_out_channel oc, (fun _ -> close_out oc)
+ | None when !stdin -> Pretty_print.to_out_channel stdout,(fun _ -> ())
+ | None -> Arg.usage options usage_header; exit 0 in
+
+ let pretty = Option.Optim.pretty () in
+ Pretty_print.set_compact pp (not pretty);
+ Code.Var.set_pretty pretty;
+
+ let error_of_pi pi =
+ if pi.Parse_info.name = ""
+ then error "error at l:%d col:%d" pi.Parse_info.line pi.Parse_info.col
+ else error "error at file:%S l:%d col:%d" pi.Parse_info.name pi.Parse_info.line pi.Parse_info.col in
+
+ let p = List.flatten (List.map (fun file ->
+ let lex = Parse_js.lexer_from_file file in
+ try Parse_js.parse lex with Parse_js.Parsing_error pi -> error_of_pi pi) !js_files) in
+
+ let p =
+ if !stdin
+ then
+ let lex = Parse_js.lexer_from_channel Pervasives.stdin in
+ try p@(Parse_js.parse lex) with Parse_js.Parsing_error pi -> error_of_pi pi;
+ else
+ p in
+
+ let true_ = (fun () -> true) in
+ let open Option in
+ let passes : ((unit -> bool) * (unit -> Js_traverse.mapper)) list =
+ [ Optim.shortvar, (fun () -> ((new Js_traverse.rename_variable Util.StringSet.empty) :> Js_traverse.mapper) );
+ Optim.share_constant, (fun () -> new Js_traverse.share_constant);
+ true_, (fun () -> new Js_traverse.simpl);
+ true_, (fun () -> new Js_traverse.clean);
+ ] in
+
+ let p = List.fold_left (fun p (t,m) -> if t() then (m())#program p else p) p passes in
+ let p = Js_assign.program p in
+ Js_output.program pp (fun _ -> None) p;
+ finalize()
+
+
+let _ =
+ try run () with
+ | (Match_failure _ | Assert_failure _ | Not_found) as exc ->
+ let backtrace = Printexc.get_backtrace () in
+ Format.eprintf
+ "%s: You found a bug. \
+ Please report it at https://github.com/ocsigen/js_of_ocaml/issues :@."
+ Sys.argv.(0);
+ Format.eprintf "Error: %s@." (Printexc.to_string exc);
+ prerr_string backtrace;
+ exit 1
+ | Failure s ->
+ Format.eprintf "%s: Error: %s@." Sys.argv.(0) s;
+ exit 1
+ | exc ->
+ Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc);
+ exit 1
diff -Nru js-of-ocaml-1.4/compiler/option.ml js-of-ocaml-2.2/compiler/option.ml
--- js-of-ocaml-1.4/compiler/option.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/option.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,123 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*)
+
+
+
+let global_object = "joo_global_object"
+
+let extra_js_files = ["+weak.js" ; "+graphics.js"; "+toplevel.js"]
+
+(* Optimisation *)
+
+module Debug = struct
+ let debugs : (string * bool ref) list ref = ref []
+
+ let find s =
+ let state =
+ try
+ List.assoc s !debugs
+ with Not_found ->
+ let state = ref false in
+ debugs := (s, state) :: !debugs;
+ state
+ in
+ fun () -> !state
+
+ let enable s =
+ try List.assoc s !debugs := true with Not_found ->
+ failwith (Printf.sprintf "The debug named %S doesn't exist" s)
+
+ let disable s =
+ try List.assoc s !debugs := false with Not_found ->
+ failwith (Printf.sprintf "The debug named %S doesn't exist" s)
+
+end
+
+module Optim = struct
+
+ let optims = ref []
+
+ let o ~name ~default =
+ let state =
+ try
+ List.assoc name !optims
+ with Not_found ->
+ let state = ref default in
+ optims := (name, state) :: !optims;
+ state
+ in
+ fun () -> !state
+
+ let disable s =
+ try List.assoc s !optims := false with Not_found ->
+ failwith (Printf.sprintf "The option named %S doesn't exist" s)
+
+ let enable s =
+ try List.assoc s !optims := true with Not_found ->
+ failwith (Printf.sprintf "The option named %S doesn't exist" s)
+
+ let pretty = o ~name:"pretty" ~default:false
+ let debuginfo = o ~name:"debuginfo" ~default:false
+ let deadcode = o ~name:"deadcode" ~default:true
+ let shortvar = o ~name:"shortvar" ~default:true
+ let compact = o ~name:"compact" ~default:true
+ let optcall = o ~name:"optcall" ~default:true
+ let inline = o ~name:"inline" ~default:true
+ let staticeval = o ~name:"staticeval" ~default:true
+ let share_constant = o ~name:"share" ~default:true
+ let strictmode = o ~name:"strict" ~default:true
+ let debugger = o ~name:"debugger" ~default:true
+ let genprim = o ~name:"genprim" ~default:true
+ let excwrap = o ~name:"excwrap" ~default:true
+ let include_cmis = o ~name:"withcmi" ~default: true
+ let warn_unused = o ~name:"warn-unused" ~default: false
+
+ let inline_callgen = o ~name:"callgen" ~default:false
+
+ (* this does not optimize properly *)
+ let compact_vardecl = o ~name:"vardecl" ~default:false
+end
+
+module Tailcall = struct
+ type t =
+ | TcNone
+ | TcTrampoline
+ | TcWhile
+
+ let default = TcTrampoline
+
+ let all = default :: List.filter ((<>) default) [TcNone;TcTrampoline(* ;TcWhile *)]
+
+ let to_string = function
+ | TcNone -> "none"
+ | TcTrampoline -> "trampoline"
+ | TcWhile -> "while"
+
+ let of_string =
+ let all_string = List.map (fun x -> to_string x,x) all in
+ fun x -> List.assoc x all_string
+
+
+ let set,get =
+ let r = ref default in
+ (fun x -> r:=x),(fun () -> !r)
+
+ let maximum () = 50
+
+end
diff -Nru js-of-ocaml-1.4/compiler/option.mli js-of-ocaml-2.2/compiler/option.mli
--- js-of-ocaml-1.4/compiler/option.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/option.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,64 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*)
+
+module Debug : sig
+ val find : string -> unit -> bool
+ val enable : string -> unit
+ val disable : string -> unit
+end
+
+module Optim : sig
+ val deadcode : unit -> bool
+ val optcall : unit -> bool
+ val shortvar : unit -> bool
+ val compact : unit -> bool
+ val inline : unit -> bool
+ val share_constant : unit -> bool
+ val staticeval : unit -> bool
+ val genprim : unit -> bool
+ val strictmode : unit -> bool
+ val compact_vardecl : unit -> bool
+ val debugger : unit -> bool
+ val pretty : unit -> bool
+ val debuginfo : unit -> bool
+ val excwrap : unit -> bool
+ val include_cmis: unit -> bool
+
+ val warn_unused : unit -> bool
+ val inline_callgen : unit -> bool
+
+ val enable : string -> unit
+ val disable : string -> unit
+end
+
+module Tailcall : sig
+ type t =
+ | TcNone
+ | TcTrampoline
+ | TcWhile
+ val get : unit -> t
+ val set : t -> unit
+ val of_string : string -> t
+ val to_string : t -> string
+ val all : t list
+ val maximum : unit -> int
+end
+
+val global_object : string
+val extra_js_files : string list
diff -Nru js-of-ocaml-1.4/compiler/parse_bytecode.ml js-of-ocaml-2.2/compiler/parse_bytecode.ml
--- js-of-ocaml-1.4/compiler/parse_bytecode.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_bytecode.ml 2014-05-15 08:37:39.000000000 +0000
@@ -16,111 +16,135 @@
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-(*XXX FIX: avoid the need of global datastructures for analyse_blocks *)
+*)
open Code
open Instr
-let debug = Util.debug "parser"
-
-(****)
-
-let blocks = ref AddrSet.empty
-
-type debug_loc = int -> (string * int * int * int) option
+let debug_parser = Option.Debug.find "parser"
-let add_jump info pc = blocks := AddrSet.add pc !blocks
+type debug_loc = Javascript.loc -> Parse_info.t option
+type code = string
-let rec scan info code pc len =
- if pc < len then begin
- match (get_instr code pc).kind with
- KNullary ->
- scan info code (pc + 1) len
- | KUnary ->
- scan info code (pc + 2) len
- | KBinary ->
- scan info code (pc + 3) len
- | KJump ->
+(* Block analysis *)
+(* Detect each block *)
+module Blocks : sig
+ type t
+ val add : t -> int -> t
+ val next : t -> int -> int
+ val analyse : code -> t
+end = struct
+ type t = AddrSet.t * int
+
+ let add (blocks,len) pc = AddrSet.add pc blocks,len
+ let rec scan blocks code pc len =
+ if pc < len then begin
+ match (get_instr code pc).kind with
+ KNullary ->
+ scan blocks code (pc + 1) len
+ | KUnary ->
+ scan blocks code (pc + 2) len
+ | KBinary ->
+ scan blocks code (pc + 3) len
+ | KJump ->
let offset = gets code (pc + 1) in
- add_jump info (pc + offset + 1);
- scan info code (pc + 2) len
- | KCond_jump ->
+ let blocks = AddrSet.add (pc + offset + 1) blocks in
+ scan blocks code (pc + 2) len
+ | KCond_jump ->
let offset = gets code (pc + 1) in
- add_jump info (pc + offset + 1);
- scan info code (pc + 2) len
- | KCmp_jump ->
+ let blocks = AddrSet.add (pc + offset + 1) blocks in
+ scan blocks code (pc + 2) len
+ | KCmp_jump ->
let offset = gets code (pc + 2) in
- add_jump info (pc + offset + 2);
- scan info code (pc + 3) len
- | KSwitch ->
+ let blocks = AddrSet.add (pc + offset + 2) blocks in
+ scan blocks code (pc + 3) len
+ | KSwitch ->
let sz = getu code (pc + 1) in
+ let blocks = ref blocks in
for i = 0 to sz land 0xffff + sz lsr 16 - 1 do
let offset = gets code (pc + 2 + i) in
- add_jump info (pc + offset + 2)
+ blocks := AddrSet.add (pc + offset + 2) !blocks
done;
- scan info code (pc + 2 + sz land 0xffff + sz lsr 16) len
- | KClosurerec ->
+ scan !blocks code (pc + 2 + sz land 0xffff + sz lsr 16) len
+ | KClosurerec ->
let nfuncs = getu code (pc + 1) in
- scan info code (pc + nfuncs + 3) len
- | KClosure ->
- scan info code (pc + 3) len
- | KStop n ->
- scan info code (pc + n + 1) len
- end
+ scan blocks code (pc + nfuncs + 3) len
+ | KClosure ->
+ scan blocks code (pc + 3) len
+ | KStop n ->
+ scan blocks code (pc + n + 1) len
+ end
+ else blocks
-let rec next_block len pc =
- let pc = pc + 1 in
- if pc = len || AddrSet.mem pc !blocks then pc else next_block len pc
-
-let analyse_blocks code =
- blocks := AddrSet.empty;
- let len = String.length code / 4 in
- scan () code 0 len
+ let rec next ((blocks,len) as info) pc =
+ let pc = pc + 1 in
+ if pc = len || AddrSet.mem pc blocks then pc else next info pc
-(****)
+ let analyse code =
+ let blocks = AddrSet.empty in
+ let len = String.length code / 4 in
+ (scan blocks code 0 len,len)
-let same_custom x y =
- Obj.field x 0 == Obj.field (Obj.repr y) 0
+end
-let rec parse_const x =
- if Obj.is_block x then begin
- let tag = Obj.tag x in
- if tag = Obj.string_tag then
- String (Obj.magic x : string)
- else if tag = Obj.double_tag then
- Float (Obj.magic x : float)
- else if tag = Obj.double_array_tag then
- Float_array (Obj.magic x : float array)
- else if tag = Obj.custom_tag && same_custom x 0l then
- Int32 (Obj.magic x : int32)
- else if tag = Obj.custom_tag && same_custom x 0n then
- Nativeint (Obj.magic x : nativeint)
- else if tag = Obj.custom_tag && same_custom x 0L then
- Int64 (Obj.magic x : int64)
- else if tag < Obj.no_scan_tag then
- Tuple (tag,
- Array.init (Obj.size x) (fun i -> parse_const (Obj.field x i)))
- else
- assert false
- end else
- Int (Obj.magic x : int)
+(* Parse constants *)
+module Constants : sig
+ val parse : Obj.t -> Code.constant
+ val inlined : Obj.t -> bool
+end = struct
+ let same_custom x y =
+ Obj.field x 0 == Obj.field (Obj.repr y) 0
-let inlined_const x =
- not (Obj.is_block x)
- ||
- (let tag = Obj.tag x in
- (tag = Obj.double_tag)
- ||
- (tag = Obj.custom_tag && (same_custom x 0l || same_custom x 0n)))
+ let warn_overflow i i32 =
+ Format.eprintf
+ "Warning: integer overflow: integer 0x%s truncated to 0x%lx; \
+ the generated code might be incorrect.@." i i32
-(****)
+ let rec parse x =
+ if Obj.is_block x then begin
+ let tag = Obj.tag x in
+ if tag = Obj.string_tag then
+ String (Obj.magic x : string)
+ else if tag = Obj.double_tag then
+ Float (Obj.magic x : float)
+ else if tag = Obj.double_array_tag then
+ Float_array (Obj.magic x : float array)
+ else if tag = Obj.custom_tag && same_custom x 0l then
+ Int (Obj.magic x : int32)
+ else if tag = Obj.custom_tag && same_custom x 0n then
+ let i : nativeint = Obj.magic x in
+ let i32 = Nativeint.to_int32 i in
+ let i' = Nativeint.of_int32 i32 in
+ if i' <> i then warn_overflow (Printf.sprintf "%nx" i) i32;
+ Int i32
+ else if tag = Obj.custom_tag && same_custom x 0L then
+ Int64 (Obj.magic x : int64)
+ else if tag < Obj.no_scan_tag then
+ Tuple (tag,
+ Array.init (Obj.size x) (fun i -> parse (Obj.field x i)))
+ else
+ assert false
+ end else
+ let i : int = Obj.magic x in
+ let i32 = Int32.of_int i in
+ let i' = Int32.to_int i32 in
+ if i' <> i then warn_overflow (Printf.sprintf "%x" i) i32;
+ Int i32
+ let inlined x =
+ not (Obj.is_block x)
+ ||
+ (let tag = Obj.tag x in
+ (tag = Obj.double_tag)
+ ||
+ (tag = Obj.custom_tag && (same_custom x 0l || same_custom x 0n)))
+end
+
+(* Copied from ocaml/typing/ident.ml *)
module Ident = struct
type t = { stamp: int; name: string; mutable flags: int }
type 'a tbl =
- Empty
+ | Empty
| Node of 'a tbl * 'a data * 'a tbl * int
and 'a data =
{ ident: t;
@@ -130,33 +154,92 @@
let rec table_contents_rec sz t rem =
match t with
Empty ->
- rem
+ rem
| Node (l, v, r, _) ->
- table_contents_rec sz l
- ((sz - v.data, v.ident.name) :: table_contents_rec sz r rem)
+ table_contents_rec sz l
+ ((sz - v.data, v.ident.name) :: table_contents_rec sz r rem)
let table_contents sz t =
List.sort (fun (i, _) (j, _) -> compare i j)
(table_contents_rec sz t [])
end
-
+(* Copied from ocaml/utils/tbl.ml *)
module Tbl = struct
type ('a, 'b) t =
- Empty
+ | Empty
| Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t * int
let rec iter f = function
Empty -> ()
| Node(l, v, d, r, _) ->
- iter f l; f v d; iter f r
+ iter f l; f v d; iter f r
+
+ let rec find compare x = function
+ Empty ->
+ raise Not_found
+ | Node(l, v, d, r, _) ->
+ let c = compare x v in
+ if c = 0 then d
+ else find compare x (if c < 0 then l else r)
+
+ let rec fold f m accu =
+ match m with
+ | Empty -> accu
+ | Node(l, v, d, r, _) ->
+ fold f r (f v d (fold f l accu))
end
type 'a numtable =
{ num_cnt: int;
num_tbl: ('a, int) Tbl.t }
-module Debug = struct
+(* Read and manipulate debug section *)
+module Debug : sig
+ type compilation_env =
+ { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
+ ce_heap: int Ident.tbl; (* Structure of the heap-allocated env *)
+ ce_rec: int Ident.tbl } (* Functions bound by the same let rec *)
+
+ type pos =
+ { pos_fname: string;
+ pos_lnum: int;
+ pos_bol: int;
+ pos_cnum: int }
+
+ type loc_info =
+ { li_start: pos;
+ li_end: pos;
+ li_ghost: unit }
+
+ type debug_event =
+ { mutable ev_pos: int; (* Position in bytecode *)
+ ev_module: string; (* Name of defining module *)
+ ev_loc: loc_info; (* Location in source file *)
+ ev_kind: debug_event_kind; (* Before/after event *)
+ ev_info: debug_event_info; (* Extra information *)
+ ev_typenv: unit; (* Typing environment *)
+ ev_typsubst: unit; (* Substitution over types *)
+ ev_compenv: compilation_env; (* Compilation environment *)
+ ev_stacksize: int; (* Size of stack frame *)
+ ev_repr: unit } (* Position of the representative *)
+
+ and debug_event_kind =
+ Event_before
+ | Event_after of unit
+ | Event_pseudo
+
+ and debug_event_info = unit
+ (* Event_function *)
+ (* | Event_return of int *)
+ (* | Event_other *)
+
+ val propagate : Code.Var.t list -> Code.Var.t list -> unit
+ val find : Code.addr -> (int * string) list
+ val find_loc : Code.DebugAddr.dbg -> Parse_info.t option
+ val read : in_channel -> unit
+ val fold : (Code.addr -> debug_event -> 'a -> 'a) -> 'a -> 'a
+end = struct
type compilation_env =
{ ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
@@ -178,24 +261,39 @@
{ mutable ev_pos: int; (* Position in bytecode *)
ev_module: string; (* Name of defining module *)
ev_loc: loc_info; (* Location in source file *)
- ev_kind: unit; (* Before/after event *)
- ev_info: unit; (* Extra information *)
+ ev_kind: debug_event_kind; (* Before/after event *)
+ ev_info: debug_event_info; (* Extra information *)
ev_typenv: unit; (* Typing environment *)
ev_typsubst: unit; (* Substitution over types *)
ev_compenv: compilation_env; (* Compilation environment *)
ev_stacksize: int; (* Size of stack frame *)
ev_repr: unit } (* Position of the representative *)
+ and debug_event_kind =
+ Event_before
+ | Event_after of unit
+ | Event_pseudo
+
+ and debug_event_info = unit
+ (* Event_function *)
+ (* | Event_return of int *)
+ (* | Event_other *)
+
let relocate_event orig ev = ev.ev_pos <- (orig + ev.ev_pos) / 4
let events_by_pc =
(Hashtbl.create 257 : (int, debug_event) Hashtbl.t)
let read ic =
+ let read_paths : unit -> string list =
+ match Util.Version.v with
+ | `V3 -> (fun () -> [])
+ | `V4_02 -> (fun () -> (input_value ic : string list)) in
let len = input_binary_int ic in
for i = 0 to len - 1 do
let orig = input_binary_int ic in
let evl : debug_event list = input_value ic in
+ ignore(read_paths ());
List.iter
(fun ev ->
relocate_event orig ev; Hashtbl.add events_by_pc ev.ev_pos ev)
@@ -210,32 +308,39 @@
[]
let find_loc pc =
+ let pc = Code.DebugAddr.to_addr pc in
try
let ev = Hashtbl.find events_by_pc pc in
let loc = ev.ev_loc in
- let pos = loc.li_start in
- Some (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol,
- loc.li_end.pos_cnum - loc.li_end.pos_bol)
+ let pos =
+ match ev.ev_kind with Event_after _ -> loc.li_end | _ -> loc.li_start in
+ Some {Parse_info.name = pos.pos_fname;
+ line=pos.pos_lnum - 1;
+ col=pos.pos_cnum - pos.pos_bol;
+ (* loc.li_end.pos_cnum - loc.li_end.pos_bol *)
+ idx=0;
+ fol=None}
with Not_found ->
None
let rec propagate l1 l2 =
match l1, l2 with
- v1 :: r1, v2 :: r2 -> Var.propagate_name v1 v2; propagate r1 r2
+ v1 :: r1, v2 :: r2 ->
+ Var.propagate_name v1 v2;
+ propagate r1 r2
| _ -> ()
-end
-
-let keep_variable_names = ref false
-
-let set_pretty () = keep_variable_names := true; Code.Var.set_pretty ()
+ let iter f = Hashtbl.iter f events_by_pc
-(****)
+ let fold f acc = Hashtbl.fold f events_by_pc acc
+end
+(* Globals *)
type globals =
{ mutable vars : Var.t option array;
mutable is_const : bool array;
mutable is_exported : bool array;
+ mutable override : (Var.t -> Code.instr list -> (Var.t * Code.instr list)) option array;
constants : Obj.t array;
primitives : string array }
@@ -243,6 +348,7 @@
{ vars = Array.create size None;
is_const = Array.create size false;
is_exported = Array.create size false;
+ override = Array.create size None;
constants = constants; primitives = primitives }
let resize_array a len def =
@@ -253,8 +359,11 @@
let resize_globals g size =
g.vars <- resize_array g.vars size None;
g.is_const <- resize_array g.is_const size false;
- g.is_exported <- resize_array g.is_exported size false
+ g.is_exported <- resize_array g.is_exported size true;
+ g.override <- resize_array g.override size None
+
+(* State of the VM *)
module State = struct
type elt = Var of Var.t | Dummy
@@ -265,17 +374,16 @@
let print_elt f v =
match v with
| Var x -> Format.fprintf f "%a" Var.print x
-(* | Addr x -> Format.fprintf f "[%d]" x*)
+ (* | Addr x -> Format.fprintf f "[%d]" x*)
| Dummy -> Format.fprintf f "???"
type t =
{ accu : elt; stack : elt list; env : elt array; env_offset : int;
- handlers : (Var.t * addr * int) list;
- var_stream : Var.stream; globals : globals }
+ handlers : (Var.t * addr * int) list; globals : globals }
let fresh_var state =
- let (x, stream) = Var.next state.var_stream in
- (x, {state with var_stream = stream; accu = Var x})
+ let x = Var.fresh () in
+ (x, {state with accu = Var x})
let globals st = st.globals
@@ -284,9 +392,9 @@
let rec list_start n l =
if n = 0 then [] else
- match l with
- [] -> assert false
- | v :: r -> v :: list_start (n - 1) r
+ match l with
+ [] -> assert false
+ | v :: r -> v :: list_start (n - 1) r
let rec st_pop n st =
if n = 0 then
@@ -323,24 +431,12 @@
let grab n st = (List.map elt_to_var (list_start n st.stack), pop n st)
- let rec st_unalias s x n y =
- match s with
- [] ->
- []
- | z :: rem ->
- (if n <> 0 && z = Var x then Var y else z) ::
- st_unalias rem x (n - 1) y
-
- let unalias st x n y =
- assert (List.nth st.stack n = Var x);
- {st with stack = st_unalias st.stack x n y }
-
let rec st_assign s n x =
match s with
[] ->
- assert false
+ assert false
| y :: rem ->
- if n = 0 then x :: rem else y :: st_assign rem (n - 1) x
+ if n = 0 then x :: rem else y :: st_assign rem (n - 1) x
let assign st n =
{st with stack = st_assign st.stack n st.accu }
@@ -350,21 +446,25 @@
handlers = []}
let start_block state =
- let (stack, stream) =
+ let stack =
List.fold_right
- (fun e (stack, stream) ->
+ (fun e stack ->
match e with
Dummy ->
- (Dummy :: stack, stream)
- | Var _ ->
- let (x, stream) = Var.next stream in
- (Var x :: stack, stream))
- state.stack ([], state.var_stream)
+ Dummy :: stack
+ | Var x ->
+ let y = Var.fresh () in
+ Var.propagate_name x y;
+ Var y :: stack)
+ state.stack []
in
- let state = { state with stack = stack; var_stream = stream } in
+ let state = { state with stack = stack } in
match state.accu with
Dummy -> state
- | Var _ -> snd (fresh_var state)
+ | Var x ->
+ let y,state = fresh_var state in
+ Var.propagate_name x y;
+ state
let push_handler state x addr =
{ state
@@ -376,18 +476,18 @@
let current_handler state =
match state.handlers with
[] ->
- None
+ None
| (x, addr, len) :: _ ->
- let state =
- { state
- with accu = Var x;
- stack = st_pop (List.length state.stack - len) state.stack}
- in
- Some (x, (addr, stack_vars state))
+ let state =
+ { state
+ with accu = Var x;
+ stack = st_pop (List.length state.stack - len) state.stack}
+ in
+ Some (x, (addr, stack_vars state))
let initial g =
{ accu = Dummy; stack = []; env = [||]; env_offset = 0; handlers = [];
- var_stream = Var.make_stream (); globals = g }
+ globals = g }
let rec print_stack f l =
match l with
@@ -407,185 +507,207 @@
let rec name_rec i l s =
match l, s with
[], _ ->
- ()
+ ()
| (j, nm) :: lrem, Var v :: srem when i = j ->
- Var.name v nm; name_rec (i + 1) lrem srem
+ Var.name v nm; name_rec (i + 1) lrem srem
| (j, _) :: _, _ :: srem when i < j ->
- name_rec (i + 1) l srem
+ name_rec (i + 1) l srem
| _ ->
- assert false
+ assert false
let name_vars st l = name_rec 0 l st.stack
+
+ let rec make_stack i state =
+ if i = 0
+ then ([], state)
+ else
+ let (x, state) = fresh_var state in
+ let (params, state) = make_stack (pred i) (push state) in
+ if debug_parser () then if i > 1 then Format.printf ", ";
+ if debug_parser () then Format.printf "%a" Var.print x;
+ (x :: params, state)
end
let primitive_name state i =
let g = State.globals state in
assert (i >= 0 && i <= Array.length g.primitives);
- g.primitives.(i)
+ let prim = g.primitives.(i) in
+ Primitive.add_external prim;
+ prim
let access_global g i =
match g.vars.(i) with
Some x ->
- x
+ x
| None ->
- g.is_const.(i) <- true;
- let x = Var.fresh () in
- g.vars.(i) <- Some x;
- x
+ g.is_const.(i) <- true;
+ let x = Var.fresh () in
+ g.vars.(i) <- Some x;
+ x
+
+let register_global ?(force=false) g i rem =
+ if force || g.is_exported.(i)
+ then
+ Let (Var.fresh (),
+ Prim (Extern "caml_register_global",
+ [Pc (Int (Int32.of_int i)) ;
+ Pv (access_global g i)])) :: rem
+ else rem
let get_global state instrs i =
State.size_globals state (i + 1);
let g = State.globals state in
match g.vars.(i) with
Some x ->
- if debug () then Format.printf "(global access %a)@." Var.print x;
- (x, State.set_accu state x, instrs)
+ if debug_parser () then Format.printf "(global access %a)@." Var.print x;
+ (x, State.set_accu state x, instrs)
| None ->
- if
- i < Array.length g.constants && inlined_const g.constants.(i)
- then begin
- let (x, state) = State.fresh_var state in
- (x, state, Let (x, Constant (parse_const g.constants.(i))) :: instrs)
- end else begin
- g.is_const.(i) <- true;
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = CONST(%d)@." Var.print x i;
- g.vars.(i) <- Some x;
- (x, state, instrs)
- end
+ if
+ i < Array.length g.constants && Constants.inlined g.constants.(i)
+ then begin
+ let (x, state) = State.fresh_var state in
+ (x, state, Let (x, Constant (Constants.parse g.constants.(i))) :: instrs)
+ end else begin
+ g.is_const.(i) <- true;
+ let (x, state) = State.fresh_var state in
+ if debug_parser () then Format.printf "%a = CONST(%d)@." Var.print x i;
+ g.vars.(i) <- Some x;
+ (x, state, instrs)
+ end
let tagged_blocks = ref AddrSet.empty
let compiled_blocks = ref AddrMap.empty
+let method_cache_id = ref 1
-let rec compile_block code pc state =
+
+let rec compile_block blocks code pc state =
if not (AddrSet.mem pc !tagged_blocks) then begin
- let len = String.length code / 4 in
- let limit = next_block len pc in
- if debug () then Format.eprintf "Compiling from %d to %d@." pc (limit - 1);
+ let limit = Blocks.next blocks pc in
+ if debug_parser () then Format.eprintf "Compiling from %d to %d@." pc (limit - 1);
let state = State.start_block state in
tagged_blocks := AddrSet.add pc !tagged_blocks;
- let (instr, last, state') = compile code limit pc state [] in
+ let (instr, last, state') = compile blocks code limit pc state [] in
compiled_blocks :=
AddrMap.add pc (state, List.rev instr, last) !compiled_blocks;
begin match last with
- Branch (pc', _) | Poptrap (pc', _) ->
- compile_block code pc' state'
- | Cond (_, _, (pc1, _), (pc2, _)) ->
- compile_block code pc1 state';
- compile_block code pc2 state'
- | Switch (_, l1, l2) ->
- Array.iter (fun (pc', _) -> compile_block code pc' state') l1;
- Array.iter (fun (pc', _) -> compile_block code pc' state') l2
- | Pushtrap _ | Raise _ | Return _ | Stop ->
+ Branch (pc', _) | Poptrap (pc', _) ->
+ compile_block blocks code pc' state'
+ | Cond (_, _, (pc1, _), (pc2, _)) ->
+ compile_block blocks code pc1 state';
+ compile_block blocks code pc2 state'
+ | Switch (_, l1, l2) ->
+ Array.iter (fun (pc', _) -> compile_block blocks code pc' state') l1;
+ Array.iter (fun (pc', _) -> compile_block blocks code pc' state') l2
+ | Pushtrap _ | Raise _ | Return _ | Stop ->
()
end
end
-and compile code limit pc state instrs =
- if debug () then State.print state;
+and compile blocks code limit pc state instrs =
+ if debug_parser () then State.print state;
if pc = limit then
(instrs, Branch (pc, State.stack_vars state), state)
else begin
- if debug () then Format.eprintf "%4d " pc;
+ if debug_parser () then Format.eprintf "%4d " pc;
- State.name_vars state (Debug.find pc);
+ State.name_vars state (Debug.find pc);
- let instr =
- try
- get_instr code pc
- with Bad_instruction op ->
- if debug () then Format.eprintf "%08x@." op;
- assert false
- in
- if debug () then Format.eprintf "%08x %s@." instr.opcode instr.name;
- match instr.code with
- | ACC0 ->
- compile code limit (pc + 1) (State.acc 0 state) instrs
- | ACC1 ->
- compile code limit (pc + 1) (State.acc 1 state) instrs
- | ACC2 ->
- compile code limit (pc + 1) (State.acc 2 state) instrs
- | ACC3 ->
- compile code limit (pc + 1) (State.acc 3 state) instrs
- | ACC4 ->
- compile code limit (pc + 1) (State.acc 4 state) instrs
- | ACC5 ->
- compile code limit (pc + 1) (State.acc 5 state) instrs
- | ACC6 ->
- compile code limit (pc + 1) (State.acc 6 state) instrs
- | ACC7 ->
- compile code limit (pc + 1) (State.acc 7 state) instrs
- | ACC ->
+ let instr =
+ try
+ get_instr code pc
+ with Bad_instruction op ->
+ if debug_parser () then Format.eprintf "%08x@." op;
+ assert false
+ in
+ if debug_parser () then Format.eprintf "%08x %s@." instr.opcode instr.name;
+ match instr.code with
+ | ACC0 ->
+ compile blocks code limit (pc + 1) (State.acc 0 state) instrs
+ | ACC1 ->
+ compile blocks code limit (pc + 1) (State.acc 1 state) instrs
+ | ACC2 ->
+ compile blocks code limit (pc + 1) (State.acc 2 state) instrs
+ | ACC3 ->
+ compile blocks code limit (pc + 1) (State.acc 3 state) instrs
+ | ACC4 ->
+ compile blocks code limit (pc + 1) (State.acc 4 state) instrs
+ | ACC5 ->
+ compile blocks code limit (pc + 1) (State.acc 5 state) instrs
+ | ACC6 ->
+ compile blocks code limit (pc + 1) (State.acc 6 state) instrs
+ | ACC7 ->
+ compile blocks code limit (pc + 1) (State.acc 7 state) instrs
+ | ACC ->
let n = getu code (pc + 1) in
- compile code limit (pc + 2) (State.acc n state) instrs
- | PUSH ->
- compile code limit (pc + 1) (State.push state) instrs
- | PUSHACC0 ->
- compile code limit (pc + 1) (State.acc 0 (State.push state)) instrs
- | PUSHACC1 ->
- compile code limit (pc + 1) (State.acc 1 (State.push state)) instrs
- | PUSHACC2 ->
- compile code limit (pc + 1) (State.acc 2 (State.push state)) instrs
- | PUSHACC3 ->
- compile code limit (pc + 1) (State.acc 3 (State.push state)) instrs
- | PUSHACC4 ->
- compile code limit (pc + 1) (State.acc 4 (State.push state)) instrs
- | PUSHACC5 ->
- compile code limit (pc + 1) (State.acc 5 (State.push state)) instrs
- | PUSHACC6 ->
- compile code limit (pc + 1) (State.acc 6 (State.push state)) instrs
- | PUSHACC7 ->
- compile code limit (pc + 1) (State.acc 7 (State.push state)) instrs
- | PUSHACC ->
+ compile blocks code limit (pc + 2) (State.acc n state) instrs
+ | PUSH ->
+ compile blocks code limit (pc + 1) (State.push state) instrs
+ | PUSHACC0 ->
+ compile blocks code limit (pc + 1) (State.acc 0 (State.push state)) instrs
+ | PUSHACC1 ->
+ compile blocks code limit (pc + 1) (State.acc 1 (State.push state)) instrs
+ | PUSHACC2 ->
+ compile blocks code limit (pc + 1) (State.acc 2 (State.push state)) instrs
+ | PUSHACC3 ->
+ compile blocks code limit (pc + 1) (State.acc 3 (State.push state)) instrs
+ | PUSHACC4 ->
+ compile blocks code limit (pc + 1) (State.acc 4 (State.push state)) instrs
+ | PUSHACC5 ->
+ compile blocks code limit (pc + 1) (State.acc 5 (State.push state)) instrs
+ | PUSHACC6 ->
+ compile blocks code limit (pc + 1) (State.acc 6 (State.push state)) instrs
+ | PUSHACC7 ->
+ compile blocks code limit (pc + 1) (State.acc 7 (State.push state)) instrs
+ | PUSHACC ->
let n = getu code (pc + 1) in
- compile code limit (pc + 2) (State.acc n (State.push state)) instrs
- | POP ->
+ compile blocks code limit (pc + 2) (State.acc n (State.push state)) instrs
+ | POP ->
let n = getu code (pc + 1) in
- compile code limit (pc + 2) (State.pop n state) instrs
- | ASSIGN ->
+ compile blocks code limit (pc + 2) (State.pop n state) instrs
+ | ASSIGN ->
let n = getu code (pc + 1) in
let state = State.assign state n in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
(* We switch to a different block as this may have
changed the exception handler continuation *)
- compile_block code (pc + 2) state;
- (Let (x, Const 0) :: instrs,
+ compile_block blocks code (pc + 2) state;
+ (Let (x, Const 0l) :: instrs,
Branch (pc + 2, State.stack_vars state),
state)
- | ENVACC1 ->
- compile code limit (pc + 1) (State.env_acc 1 state) instrs
- | ENVACC2 ->
- compile code limit (pc + 1) (State.env_acc 2 state) instrs
- | ENVACC3 ->
- compile code limit (pc + 1) (State.env_acc 3 state) instrs
- | ENVACC4 ->
- compile code limit (pc + 1) (State.env_acc 4 state) instrs
- | ENVACC ->
+ | ENVACC1 ->
+ compile blocks code limit (pc + 1) (State.env_acc 1 state) instrs
+ | ENVACC2 ->
+ compile blocks code limit (pc + 1) (State.env_acc 2 state) instrs
+ | ENVACC3 ->
+ compile blocks code limit (pc + 1) (State.env_acc 3 state) instrs
+ | ENVACC4 ->
+ compile blocks code limit (pc + 1) (State.env_acc 4 state) instrs
+ | ENVACC ->
let n = getu code (pc + 1) in
- compile code limit (pc + 2) (State.env_acc n state) instrs
- | PUSHENVACC1 ->
- compile code limit (pc + 1) (State.env_acc 1 (State.push state)) instrs
- | PUSHENVACC2 ->
- compile code limit (pc + 1) (State.env_acc 2 (State.push state)) instrs
- | PUSHENVACC3 ->
- compile code limit (pc + 1) (State.env_acc 3 (State.push state)) instrs
- | PUSHENVACC4 ->
- compile code limit (pc + 1) (State.env_acc 4 (State.push state)) instrs
- | PUSHENVACC ->
+ compile blocks code limit (pc + 2) (State.env_acc n state) instrs
+ | PUSHENVACC1 ->
+ compile blocks code limit (pc + 1) (State.env_acc 1 (State.push state)) instrs
+ | PUSHENVACC2 ->
+ compile blocks code limit (pc + 1) (State.env_acc 2 (State.push state)) instrs
+ | PUSHENVACC3 ->
+ compile blocks code limit (pc + 1) (State.env_acc 3 (State.push state)) instrs
+ | PUSHENVACC4 ->
+ compile blocks code limit (pc + 1) (State.env_acc 4 (State.push state)) instrs
+ | PUSHENVACC ->
let n = getu code (pc + 1) in
- compile code limit (pc + 2) (State.env_acc n (State.push state)) instrs
- | PUSH_RETADDR ->
- compile code limit (pc + 2)
+ compile blocks code limit (pc + 2) (State.env_acc n (State.push state)) instrs
+ | PUSH_RETADDR ->
+ compile blocks code limit (pc + 2)
{state with State.stack =
- State.Dummy :: State.Dummy :: State.Dummy :: state.State.stack}
+ State.Dummy :: State.Dummy :: State.Dummy :: state.State.stack}
instrs
- | APPLY ->
+ | APPLY ->
let n = getu code (pc + 1) in
let f = State.accu state in
let (x, state) = State.fresh_var state in
let (args, state) = State.grab n state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = %a(" Var.print x Var.print f;
for i = 0 to n - 1 do
if i > 0 then Format.printf ", ";
@@ -593,41 +715,41 @@
done;
Format.printf ")@."
end;
- compile code limit (pc + 2) (State.pop 3 state)
- (Let (x, Apply (f, args, None)) :: instrs)
- | APPLY1 ->
+ compile blocks code limit (pc + 2) (State.pop 3 state)
+ (Let (x, Apply (f, args, false)) :: instrs)
+ | APPLY1 ->
let f = State.accu state in
let (x, state) = State.fresh_var state in
let y = State.peek 0 state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a(%a)@." Var.print x
Var.print f Var.print y;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Apply (f, [y], None)) :: instrs)
- | APPLY2 ->
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Apply (f, [y], false)) :: instrs)
+ | APPLY2 ->
let f = State.accu state in
let (x, state) = State.fresh_var state in
let y = State.peek 0 state in
let z = State.peek 1 state in
- if debug () then Format.printf "%a = %a(%a, %a)@." Var.print x
- Var.print f Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 2 state)
- (Let (x, Apply (f, [y; z], None)) :: instrs)
- | APPLY3 ->
+ if debug_parser () then Format.printf "%a = %a(%a, %a)@." Var.print x
+ Var.print f Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 2 state)
+ (Let (x, Apply (f, [y; z], false)) :: instrs)
+ | APPLY3 ->
let f = State.accu state in
let (x, state) = State.fresh_var state in
let y = State.peek 0 state in
let z = State.peek 1 state in
let t = State.peek 2 state in
- if debug () then Format.printf "%a = %a(%a, %a, %a)@." Var.print x
- Var.print f Var.print y Var.print z Var.print t;
- compile code limit (pc + 1) (State.pop 3 state)
- (Let (x, Apply (f, [y; z; t], None)) :: instrs)
- | APPTERM ->
+ if debug_parser () then Format.printf "%a = %a(%a, %a, %a)@." Var.print x
+ Var.print f Var.print y Var.print z Var.print t;
+ compile blocks code limit (pc + 1) (State.pop 3 state)
+ (Let (x, Apply (f, [y; z; t], false)) :: instrs)
+ | APPTERM ->
let n = getu code (pc + 1) in
let f = State.accu state in
let (l, state) = State.grab n state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "return %a(" Var.print f;
for i = 0 to n - 1 do
if i > 0 then Format.printf ", ";
@@ -636,39 +758,39 @@
Format.printf ")@."
end;
let (x, state) = State.fresh_var state in
- (Let (x, Apply (f, l, None)) :: instrs, Return x, state)
- | APPTERM1 ->
+ (Let (x, Apply (f, l, false)) :: instrs, Return x, state)
+ | APPTERM1 ->
let f = State.accu state in
let x = State.peek 0 state in
- if debug () then Format.printf "return %a(%a)@." Var.print f Var.print x;
+ if debug_parser () then Format.printf "return %a(%a)@." Var.print f Var.print x;
let (y, state) = State.fresh_var state in
- (Let (y, Apply (f, [x], None)) :: instrs, Return y, state)
- | APPTERM2 ->
+ (Let (y, Apply (f, [x], false)) :: instrs, Return y, state)
+ | APPTERM2 ->
let f = State.accu state in
let x = State.peek 0 state in
let y = State.peek 1 state in
- if debug () then Format.printf "return %a(%a, %a)@."
- Var.print f Var.print x Var.print y;
+ if debug_parser () then Format.printf "return %a(%a, %a)@."
+ Var.print f Var.print x Var.print y;
let (z, state) = State.fresh_var state in
- (Let (z, Apply (f, [x; y], None)) :: instrs, Return z, state)
- | APPTERM3 ->
+ (Let (z, Apply (f, [x; y], false)) :: instrs, Return z, state)
+ | APPTERM3 ->
let f = State.accu state in
let x = State.peek 0 state in
let y = State.peek 1 state in
let z = State.peek 2 state in
- if debug () then Format.printf "return %a(%a, %a, %a)@."
- Var.print f Var.print x Var.print y Var.print z;
+ if debug_parser () then Format.printf "return %a(%a, %a, %a)@."
+ Var.print f Var.print x Var.print y Var.print z;
let (t, state) = State.fresh_var state in
- (Let (t, Apply (f, [x; y; z], None)) :: instrs, Return t, state)
- | RETURN ->
+ (Let (t, Apply (f, [x; y; z], false)) :: instrs, Return t, state)
+ | RETURN ->
let x = State.accu state in
- if debug () then Format.printf "return %a@." Var.print x;
+ if debug_parser () then Format.printf "return %a@." Var.print x;
(instrs, Return x, state)
- | RESTART ->
+ | RESTART ->
assert false
- | GRAB ->
- compile code limit (pc + 2) state instrs
- | CLOSURE ->
+ | GRAB ->
+ compile blocks code limit (pc + 2) state instrs
+ | CLOSURE ->
let nvars = getu code (pc + 1) in
let addr = pc + gets code (pc + 2) + 2 in
let state = if nvars > 0 then State.push state else state in
@@ -676,36 +798,26 @@
let (x, state) = State.fresh_var state in
let env =
Array.of_list (State.Dummy :: List.map (fun x -> State.Var x) vals) in
- if debug () then Format.printf "fun %a (" Var.print x;
+ if debug_parser () then Format.printf "fun %a (" Var.print x;
let nparams =
match (get_instr code addr).code with
GRAB -> getu code (addr + 1) + 1
| _ -> 1
in
let state' = State.start_function state env 0 in
- let rec make_stack i state =
- if i = nparams then ([], state) else begin
- let (x, state) = State.fresh_var state in
- let (params, state) =
- make_stack (i + 1) (State.push state) in
- if debug () then if i < nparams - 1 then Format.printf ", ";
- if debug () then Format.printf "%a" Var.print x;
- (x :: params, state)
- end
- in
- let (params, state') = make_stack 0 state' in
- if debug () then Format.printf ") {@.";
+ let (params, state') = State.make_stack nparams state' in
+ if debug_parser () then Format.printf ") {@.";
let state' = State.clear_accu state' in
- compile_block code addr state';
- if debug () then Format.printf "}@.";
+ compile_block blocks code addr state';
+ if debug_parser () then Format.printf "}@.";
let args = State.stack_vars state' in
let (state'', _, _) = AddrMap.find addr !compiled_blocks in
Debug.propagate (State.stack_vars state'') args;
- compile code limit (pc + 3) state
+ compile blocks code limit (pc + 3) state
(Let (x, Closure (List.rev params, (addr, args))) :: instrs)
- | CLOSUREREC ->
+ | CLOSUREREC ->
let nfuncs = getu code (pc + 1) in
let nvars = getu code (pc + 2) in
let state = if nvars > 0 then (State.push state) else state in
@@ -729,300 +841,287 @@
List.fold_left
(fun instr (i, x) ->
let addr = pc + 3 + gets code (pc + 3 + i) in
- if debug () then Format.printf "fun %a (" Var.print x;
+ if debug_parser () then Format.printf "fun %a (" Var.print x;
let nparams =
match (get_instr code addr).code with
GRAB -> getu code (addr + 1) + 1
| _ -> 1
in
let state' = State.start_function state env (i * 2) in
- let rec make_stack i state =
- if i = nparams then ([], state) else begin
- let (x, state) = State.fresh_var state in
- let (params, state) =
- make_stack (i + 1) (State.push state) in
- if debug () then if i < nparams - 1 then Format.printf ", ";
- if debug () then Format.printf "%a" Var.print x;
- (x :: params, state)
- end
- in
- let (params, state') = make_stack 0 state' in
- if debug () then Format.printf ") {@.";
+ let (params, state') = State.make_stack nparams state' in
+ if debug_parser () then Format.printf ") {@.";
let state' = State.clear_accu state' in
- compile_block code addr state';
- if debug () then Format.printf "}@.";
+ compile_block blocks code addr state';
+ if debug_parser () then Format.printf "}@.";
let args = State.stack_vars state' in
let (state'', _, _) = AddrMap.find addr !compiled_blocks in
Debug.propagate (State.stack_vars state'') args;
Let (x, Closure (List.rev params, (addr, args))) :: instr)
- instrs (List.rev !vars)
+ instrs (List.rev !vars)
in
- compile
- code limit (pc + 3 + nfuncs) (State.acc (nfuncs - 1) state) instrs
- | OFFSETCLOSUREM2 ->
- compile code limit (pc + 1) (State.env_acc (-2) state) instrs
- | OFFSETCLOSURE0 ->
- compile code limit (pc + 1) (State.env_acc 0 state) instrs
- | OFFSETCLOSURE2 ->
- compile code limit (pc + 1) (State.env_acc 2 state) instrs
- | OFFSETCLOSURE ->
+ compile blocks code limit (pc + 3 + nfuncs) (State.acc (nfuncs - 1) state) instrs
+ | OFFSETCLOSUREM2 ->
+ compile blocks code limit (pc + 1) (State.env_acc (-2) state) instrs
+ | OFFSETCLOSURE0 ->
+ compile blocks code limit (pc + 1) (State.env_acc 0 state) instrs
+ | OFFSETCLOSURE2 ->
+ compile blocks code limit (pc + 1) (State.env_acc 2 state) instrs
+ | OFFSETCLOSURE ->
let n = gets code (pc + 1) in
- compile code limit (pc + 2) (State.env_acc n state) instrs
- | PUSHOFFSETCLOSUREM2 ->
+ compile blocks code limit (pc + 2) (State.env_acc n state) instrs
+ | PUSHOFFSETCLOSUREM2 ->
let state = State.push state in
- compile code limit (pc + 1) (State.env_acc (-2) state) instrs
- | PUSHOFFSETCLOSURE0 ->
+ compile blocks code limit (pc + 1) (State.env_acc (-2) state) instrs
+ | PUSHOFFSETCLOSURE0 ->
let state = State.push state in
- compile code limit (pc + 1) (State.env_acc 0 state) instrs
- | PUSHOFFSETCLOSURE2 ->
+ compile blocks code limit (pc + 1) (State.env_acc 0 state) instrs
+ | PUSHOFFSETCLOSURE2 ->
let state = State.push state in
- compile code limit (pc + 1) (State.env_acc 2 state) instrs
- | PUSHOFFSETCLOSURE ->
+ compile blocks code limit (pc + 1) (State.env_acc 2 state) instrs
+ | PUSHOFFSETCLOSURE ->
let state = State.push state in
let n = gets code (pc + 1) in
- compile code limit (pc + 2) (State.env_acc n state) instrs
- | GETGLOBAL ->
+ compile blocks code limit (pc + 2) (State.env_acc n state) instrs
+ | GETGLOBAL ->
let i = getu code (pc + 1) in
let (_, state, instrs) = get_global state instrs i in
- compile code limit (pc + 2) state instrs
- | PUSHGETGLOBAL ->
+ compile blocks code limit (pc + 2) state instrs
+ | PUSHGETGLOBAL ->
let state = State.push state in
let i = getu code (pc + 1) in
let (_, state, instrs) = get_global state instrs i in
- compile code limit (pc + 2) state instrs
- | GETGLOBALFIELD ->
+ compile blocks code limit (pc + 2) state instrs
+ | GETGLOBALFIELD ->
let i = getu code (pc + 1) in
let (x, state, instrs) = get_global state instrs i in
let j = getu code (pc + 2) in
let (y, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
- compile code limit (pc + 3) state (Let (y, Field (x, j)) :: instrs)
- | PUSHGETGLOBALFIELD ->
+ if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
+ compile blocks code limit (pc + 3) state (Let (y, Field (x, j)) :: instrs)
+ | PUSHGETGLOBALFIELD ->
let state = State.push state in
let i = getu code (pc + 1) in
let (x, state, instrs) = get_global state instrs i in
let j = getu code (pc + 2) in
let (y, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
- compile code limit (pc + 3) state (Let (y, Field (x, j)) :: instrs)
- | SETGLOBAL ->
+ if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
+ compile blocks code limit (pc + 3) state (Let (y, Field (x, j)) :: instrs)
+ | SETGLOBAL ->
let i = getu code (pc + 1) in
+ State.size_globals state (i + 1);
let y = State.accu state in
let g = State.globals state in
assert (g.vars.(i) = None);
- if debug () then Format.printf "(global %d) = %a@." i Var.print y;
- g.vars.(i) <- Some y;
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- let instrs =
- if g.is_exported.(i) then begin
- let x = Var.fresh () in
- Let (Var.fresh (),
- Prim (Extern "caml_register_global",
- [Pv x ; Pv (access_global g i)])) ::
- Let (x, Const i) ::
+ if debug_parser () then Format.printf "(global %d) = %a@." i Var.print y;
+ let instrs = match g.override.(i) with
+ | Some f ->
+ let v,instrs = f y instrs in
+ g.vars.(i) <- Some v;
instrs
- end else
- instrs
- in
- compile code limit (pc + 2) state (Let (x, Const 0) :: instrs)
- | ATOM0 ->
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ATOM(0)@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Block (0, [||])) :: instrs)
- | ATOM ->
+ | None ->
+ g.vars.(i) <- Some y;
+ instrs in
+ let (x, state) = State.fresh_var state in
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ let instrs = register_global g i instrs in
+ compile blocks code limit (pc + 2) state (Let (x, Const 0l) :: instrs)
+ | ATOM0 ->
+ let (x, state) = State.fresh_var state in
+ if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
+ compile blocks code limit (pc + 1) state (Let (x, Block (0, [||])) :: instrs)
+ | ATOM ->
let i = getu code (pc + 1) in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ATOM(%d)@." Var.print x i;
- compile code limit (pc + 2) state (Let (x, Block (i, [||])) :: instrs)
- | PUSHATOM0 ->
+ if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
+ compile blocks code limit (pc + 2) state (Let (x, Block (i, [||])) :: instrs)
+ | PUSHATOM0 ->
let state = State.push state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ATOM(0)@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Block (0, [||])) :: instrs)
- | PUSHATOM ->
+ if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
+ compile blocks code limit (pc + 1) state (Let (x, Block (0, [||])) :: instrs)
+ | PUSHATOM ->
let state = State.push state in
let i = getu code (pc + 1) in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ATOM(%d)@." Var.print x i;
- compile code limit (pc + 2) state (Let (x, Block (i, [||])) :: instrs)
- | MAKEBLOCK ->
+ if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
+ compile blocks code limit (pc + 2) state (Let (x, Block (i, [||])) :: instrs)
+ | MAKEBLOCK ->
let size = getu code (pc + 1) in
let tag = getu code (pc + 2) in
let state = State.push state in
let (x, state) = State.fresh_var state in
let (contents, state) = State.grab size state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = { " Var.print x;
for i = 0 to size - 1 do
Format.printf "%d = %a; " i Var.print (List.nth contents i);
done;
Format.printf "}@."
end;
- compile code limit (pc + 3) state
+ compile blocks code limit (pc + 3) state
(Let (x, Block (tag, Array.of_list contents)) :: instrs)
- | MAKEBLOCK1 ->
+ | MAKEBLOCK1 ->
let tag = getu code (pc + 1) in
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = { 0 = %a; }@." Var.print x Var.print y;
- compile code limit (pc + 2) state (Let (x, Block (tag, [|y|])) :: instrs)
- | MAKEBLOCK2 ->
+ if debug_parser () then Format.printf "%a = { 0 = %a; }@." Var.print x Var.print y;
+ compile blocks code limit (pc + 2) state (Let (x, Block (tag, [|y|])) :: instrs)
+ | MAKEBLOCK2 ->
let tag = getu code (pc + 1) in
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = { 0 = %a; 1 = %a; }@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 2) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = { 0 = %a; 1 = %a; }@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 2) (State.pop 1 state)
(Let (x, Block (tag, [|y; z|])) :: instrs)
- | MAKEBLOCK3 ->
+ | MAKEBLOCK3 ->
let tag = getu code (pc + 1) in
let y = State.accu state in
let z = State.peek 0 state in
let t = State.peek 1 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = { 0 = %a; 1 = %a; 2 = %a }@."
- Var.print x Var.print y Var.print z Var.print t;
- compile code limit (pc + 2) (State.pop 2 state)
+ if debug_parser () then Format.printf "%a = { 0 = %a; 1 = %a; 2 = %a }@."
+ Var.print x Var.print y Var.print z Var.print t;
+ compile blocks code limit (pc + 2) (State.pop 2 state)
(Let (x, Block (tag, [|y; z; t|])) :: instrs)
- | MAKEFLOATBLOCK ->
+ | MAKEFLOATBLOCK ->
let size = getu code (pc + 1) in
let state = State.push state in
let (x, state) = State.fresh_var state in
let (contents, state) = State.grab size state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = { " Var.print x;
for i = 0 to size - 1 do
Format.printf "%d = %a; " i Var.print (List.nth contents i);
done;
Format.printf "}@."
end;
- compile code limit (pc + 2) state
+ compile blocks code limit (pc + 2) state
(Let (x, Block (254, Array.of_list contents)) :: instrs)
- | GETFIELD0 ->
+ | GETFIELD0 ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[0]@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Field (y, 0)) :: instrs)
- | GETFIELD1 ->
+ if debug_parser () then Format.printf "%a = %a[0]@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Field (y, 0)) :: instrs)
+ | GETFIELD1 ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[1]@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Field (y, 1)) :: instrs)
- | GETFIELD2 ->
+ if debug_parser () then Format.printf "%a = %a[1]@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Field (y, 1)) :: instrs)
+ | GETFIELD2 ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[2]@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Field (y, 2)) :: instrs)
- | GETFIELD3 ->
+ if debug_parser () then Format.printf "%a = %a[2]@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Field (y, 2)) :: instrs)
+ | GETFIELD3 ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[3]@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Field (y, 3)) :: instrs)
- | GETFIELD ->
+ if debug_parser () then Format.printf "%a = %a[3]@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Field (y, 3)) :: instrs)
+ | GETFIELD ->
let y = State.accu state in
let n = getu code (pc + 1) in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
- compile code limit (pc + 2) state (Let (x, Field (y, n)) :: instrs)
- | GETFLOATFIELD ->
+ if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
+ compile blocks code limit (pc + 2) state (Let (x, Field (y, n)) :: instrs)
+ | GETFLOATFIELD ->
let y = State.accu state in
let n = getu code (pc + 1) in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
- compile code limit (pc + 2) state (Let (x, Field (y, n)) :: instrs)
- | SETFIELD0 ->
+ if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
+ compile blocks code limit (pc + 2) state (Let (x, Field (y, n)) :: instrs)
+ | SETFIELD0 ->
let y = State.accu state in
let z = State.peek 0 state in
- if debug () then Format.printf "%a[0] = %a@." Var.print y Var.print z;
+ if debug_parser () then Format.printf "%a[0] = %a@." Var.print y Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, 0, z) :: instrs)
- | SETFIELD1 ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, 0, z) :: instrs)
+ | SETFIELD1 ->
let y = State.accu state in
let z = State.peek 0 state in
- if debug () then Format.printf "%a[1] = %a@." Var.print y Var.print z;
+ if debug_parser () then Format.printf "%a[1] = %a@." Var.print y Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, 1, z) :: instrs)
- | SETFIELD2 ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, 1, z) :: instrs)
+ | SETFIELD2 ->
let y = State.accu state in
let z = State.peek 0 state in
- if debug () then Format.printf "%a[2] = %a@." Var.print y Var.print z;
+ if debug_parser () then Format.printf "%a[2] = %a@." Var.print y Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, 2, z) :: instrs)
- | SETFIELD3 ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, 2, z) :: instrs)
+ | SETFIELD3 ->
let y = State.accu state in
let z = State.peek 0 state in
- if debug () then Format.printf "%a[3] = %a@." Var.print y Var.print z;
+ if debug_parser () then Format.printf "%a[3] = %a@." Var.print y Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, 3, z) :: instrs)
- | SETFIELD ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, 3, z) :: instrs)
+ | SETFIELD ->
let y = State.accu state in
let z = State.peek 0 state in
let n = getu code (pc + 1) in
- if debug () then Format.printf "%a[%d] = %a@." Var.print y n Var.print z;
+ if debug_parser () then Format.printf "%a[%d] = %a@." Var.print y n Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 2) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, n, z) :: instrs)
- | SETFLOATFIELD ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 2) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, n, z) :: instrs)
+ | SETFLOATFIELD ->
let y = State.accu state in
let z = State.peek 0 state in
let n = getu code (pc + 1) in
- if debug () then Format.printf "%a[%d] = %a@." Var.print y n Var.print z;
+ if debug_parser () then Format.printf "%a[%d] = %a@." Var.print y n Var.print z;
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 2) (State.pop 1 state)
- (Let (x, Const 0) :: Set_field (y, n, z) :: instrs)
- | VECTLENGTH ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 2) (State.pop 1 state)
+ (Let (x, Const 0l) :: Set_field (y, n, z) :: instrs)
+ | VECTLENGTH ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a.length@."
- Var.print x Var.print y;
- compile code limit (pc + 1) state
+ if debug_parser () then Format.printf "%a = %a.length@."
+ Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state
(Let (x, Prim (Vectlength, [Pv y])) :: instrs)
- | GETVECTITEM ->
+ | GETVECTITEM ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%a]@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = %a[%a]@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Array_get, [Pv y; Pv z])) :: instrs)
- | SETVECTITEM ->
- if debug () then Format.printf "%a[%a] = %a@." Var.print (State.accu state)
- Var.print (State.peek 0 state)
- Var.print (State.peek 1 state);
+ | SETVECTITEM ->
+ if debug_parser () then Format.printf "%a[%a] = %a@." Var.print (State.accu state)
+ Var.print (State.peek 0 state)
+ Var.print (State.peek 1 state);
let instrs =
Array_set (State.accu state, State.peek 0 state, State.peek 1 state)
:: instrs
in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 2 state)
- (Let (x, Const 0) :: instrs)
- | GETSTRINGCHAR ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 2 state)
+ (Let (x, Const 0l) :: instrs)
+ | GETSTRINGCHAR ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a[%a]@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = %a[%a]@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "caml_string_get", [Pv y; Pv z])) :: instrs)
- | SETSTRINGCHAR ->
- if debug () then Format.printf "%a[%a] = %a@." Var.print (State.accu state)
- Var.print (State.peek 0 state)
- Var.print (State.peek 1 state);
+ | SETSTRINGCHAR ->
+ if debug_parser () then Format.printf "%a[%a] = %a@." Var.print (State.accu state)
+ Var.print (State.peek 0 state)
+ Var.print (State.peek 1 state);
let x = State.accu state in
let y = State.peek 0 state in
let z = State.peek 1 state in
@@ -1031,27 +1130,27 @@
Let (t, Prim (Extern "caml_string_set", [Pv x; Pv y; Pv z])) ::
instrs in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) (State.pop 2 state)
- (Let (x, Const 0) :: instrs)
- | BRANCH ->
+ if debug_parser () then Format.printf "%a = 0@." Var.print x;
+ compile blocks code limit (pc + 1) (State.pop 2 state)
+ (Let (x, Const 0l) :: instrs)
+ | BRANCH ->
let offset = gets code (pc + 1) in
- if debug () then Format.printf "... (branch)@.";
+ if debug_parser () then Format.printf "... (branch)@.";
(instrs, Branch (pc + offset + 1, State.stack_vars state), state)
- | BRANCHIF ->
+ | BRANCHIF ->
let offset = gets code (pc + 1) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (IsTrue, x, (pc + offset + 1, args), (pc + 2, args)), state)
- | BRANCHIFNOT ->
+ | BRANCHIFNOT ->
let offset = gets code (pc + 1) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (IsTrue, x, (pc + 2, args), (pc + offset + 1, args)), state)
- | SWITCH ->
- if debug () then Format.printf "switch ...@.";
+ | SWITCH ->
+ if debug_parser () then Format.printf "switch ...@.";
let sz = getu code (pc + 1) in
let x = State.accu state in
let args = State.stack_vars state in
@@ -1065,70 +1164,73 @@
(fun i -> (pc + 2 + gets code (pc + 2 + l + i), args))
in
(instrs, Switch (x, it, bt), state)
- | BOOLNOT ->
+ | BOOLNOT ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = !%a@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Prim (Not, [Pv y])) :: instrs)
- | PUSHTRAP ->
+ if debug_parser () then Format.printf "%a = !%a@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Prim (Not, [Pv y])) :: instrs)
+ | PUSHTRAP ->
let addr = pc + 1 + gets code (pc + 1) in
let (x, state') = State.fresh_var state in
- compile_block code addr state';
- compile_block code (pc + 2)
+ compile_block blocks code addr state';
+ compile_block blocks code (pc + 2)
{(State.push_handler state x addr)
with State.stack =
- State.Dummy :: State.Dummy :: State.Dummy :: State.Dummy ::
- state.State.stack};
+ State.Dummy :: State.Dummy :: State.Dummy :: State.Dummy ::
+ state.State.stack};
(instrs,
Pushtrap ((pc + 2, State.stack_vars state), x,
(addr, State.stack_vars state'), -1), state)
- | POPTRAP ->
- compile_block code (pc + 1) (State.pop 4 (State.pop_handler state));
+ | POPTRAP ->
+ compile_block blocks code (pc + 1) (State.pop 4 (State.pop_handler state));
(instrs, Poptrap (pc + 1, State.stack_vars state), state)
- | RAISE ->
- if debug () then Format.printf "throw(%a)@." Var.print (State.accu state);
+ | RERAISE
+ | RAISE_NOTRACE
+ | RAISE ->
+ if debug_parser () then
+ Format.printf "throw(%a)@." Var.print (State.accu state);
(instrs, Raise (State.accu state), state)
- | CHECK_SIGNALS ->
- compile code limit (pc + 1) state instrs
- | C_CALL1 ->
+ | CHECK_SIGNALS ->
+ compile blocks code limit (pc + 1) state instrs
+ | C_CALL1 ->
let prim = primitive_name state (getu code (pc + 1)) in
if Primitive.resolve prim = "%identity" then
(* This is a no-op *)
- compile code limit (pc + 2) state instrs
+ compile blocks code limit (pc + 2) state instrs
else begin
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ccall \"%s\" (%a)@."
- Var.print x prim Var.print y;
- compile code limit (pc + 2) state
+ if debug_parser () then Format.printf "%a = ccall \"%s\" (%a)@."
+ Var.print x prim Var.print y;
+ compile blocks code limit (pc + 2) state
(Let (x, Prim (Extern prim, [Pv y])) :: instrs)
end
- | C_CALL2 ->
+ | C_CALL2 ->
let prim = primitive_name state (getu code (pc + 1)) in
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ccall \"%s\" (%a, %a)@."
- Var.print x prim Var.print y Var.print z;
- compile code limit (pc + 2) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = ccall \"%s\" (%a, %a)@."
+ Var.print x prim Var.print y Var.print z;
+ compile blocks code limit (pc + 2) (State.pop 1 state)
(Let (x, Prim (Extern prim, [Pv y; Pv z])) :: instrs)
- | C_CALL3 ->
+ | C_CALL3 ->
let prim = primitive_name state (getu code (pc + 1)) in
let y = State.accu state in
let z = State.peek 0 state in
let t = State.peek 1 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = ccall \"%s\" (%a, %a, %a)@."
- Var.print x prim Var.print y Var.print z Var.print t;
- compile code limit (pc + 2) (State.pop 2 state)
+ if debug_parser () then Format.printf "%a = ccall \"%s\" (%a, %a, %a)@."
+ Var.print x prim Var.print y Var.print z Var.print t;
+ compile blocks code limit (pc + 2) (State.pop 2 state)
(Let (x, Prim (Extern prim, [Pv y; Pv z; Pv t])) :: instrs)
- | C_CALL4 ->
+ | C_CALL4 ->
let nargs = 4 in
let prim = primitive_name state (getu code (pc + 1)) in
let state = State.push state in
let (x, state) = State.fresh_var state in
let (args, state) = State.grab nargs state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = ccal \"%s\" (" Var.print x prim;
for i = 0 to nargs - 1 do
if i > 0 then Format.printf ", ";
@@ -1136,15 +1238,15 @@
done;
Format.printf ")@."
end;
- compile code limit (pc + 2) state
+ compile blocks code limit (pc + 2) state
(Let (x, Prim (Extern prim, List.map (fun x -> Pv x) args)) :: instrs)
- | C_CALL5 ->
+ | C_CALL5 ->
let nargs = 5 in
let prim = primitive_name state (getu code (pc + 1)) in
let state = State.push state in
let (x, state) = State.fresh_var state in
let (args, state) = State.grab nargs state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = ccal \"%s\" (" Var.print x prim;
for i = 0 to nargs - 1 do
if i > 0 then Format.printf ", ";
@@ -1152,15 +1254,15 @@
done;
Format.printf ")@."
end;
- compile code limit (pc + 2) state
+ compile blocks code limit (pc + 2) state
(Let (x, Prim (Extern prim, List.map (fun x -> Pv x) args)) :: instrs)
- | C_CALLN ->
+ | C_CALLN ->
let nargs = getu code (pc + 1) in
let prim = primitive_name state (getu code (pc + 2)) in
let state = State.push state in
let (x, state) = State.fresh_var state in
let (args, state) = State.grab nargs state in
- if debug () then begin
+ if debug_parser () then begin
Format.printf "%a = ccal \"%s\" (" Var.print x prim;
for i = 0 to nargs - 1 do
if i > 0 then Format.printf ", ";
@@ -1168,332 +1270,312 @@
done;
Format.printf ")@."
end;
- compile code limit (pc + 3) state
+ compile blocks code limit (pc + 3) state
(Let (x, Prim (Extern prim, List.map (fun x -> Pv x) args)) :: instrs)
- | CONST0 ->
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 0) :: instrs)
- | CONST1 ->
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 1@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 1) :: instrs)
- | CONST2 ->
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 2@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 2) :: instrs)
- | CONST3 ->
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 3@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 3) :: instrs)
- | CONSTINT ->
- let n = gets code (pc + 1) in
+ | ( CONST0 | CONST1 | CONST2 | CONST3 ) as cc ->
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %d@." Var.print x n;
- compile code limit (pc + 2) state (Let (x, Const n) :: instrs)
- | PUSHCONST0 ->
+ let n = match cc with
+ | CONST0 -> 0l
+ | CONST1 -> 1l
+ | CONST2 -> 2l
+ | CONST3 -> 3l
+ | _ -> assert false in
+ if debug_parser () then Format.printf "%a = %ld@." Var.print x n;
+ compile blocks code limit (pc + 1) state (Let (x, Const n) :: instrs)
+ | CONSTINT ->
+ let n = gets32 code (pc + 1) in
+ let (x, state) = State.fresh_var state in
+ if debug_parser () then Format.printf "%a = %ld@." Var.print x n;
+ compile blocks code limit (pc + 2) state (Let (x, Const n) :: instrs)
+ | ( PUSHCONST0 | PUSHCONST1 | PUSHCONST2 | PUSHCONST3 ) as cc ->
let state = State.push state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 0@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 0) :: instrs)
- | PUSHCONST1 ->
+ let n = match cc with
+ | PUSHCONST0 -> 0l
+ | PUSHCONST1 -> 1l
+ | PUSHCONST2 -> 2l
+ | PUSHCONST3 -> 3l
+ | _ -> assert false in
+ if debug_parser () then Format.printf "%a = %ld@." Var.print x n;
+ compile blocks code limit (pc + 1) state (Let (x, Const n) :: instrs)
+ | PUSHCONSTINT ->
let state = State.push state in
+ let n = gets32 code (pc + 1) in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 1@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 1) :: instrs)
- | PUSHCONST2 ->
- let state = State.push state in
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 2@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 2) :: instrs)
- | PUSHCONST3 ->
- let state = State.push state in
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = 3@." Var.print x;
- compile code limit (pc + 1) state (Let (x, Const 3) :: instrs)
- | PUSHCONSTINT ->
- let state = State.push state in
- let n = gets code (pc + 1) in
- let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %d@." Var.print x n;
- compile code limit (pc + 2) state (Let (x, Const n) :: instrs)
- | NEGINT ->
+ if debug_parser () then Format.printf "%a = %ld@." Var.print x n;
+ compile blocks code limit (pc + 2) state (Let (x, Const n) :: instrs)
+ | NEGINT ->
let y = State.accu state in
- let (x', state) = State.fresh_var state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = -%a@." Var.print x Var.print y;
- compile code limit (pc + 1) state
- (Let (x, Prim (WrapInt, [Pv x'])) ::
- Let (x', Prim (Extern "%int_neg", [Pv y])) :: instrs)
- | ADDINT ->
+ if debug_parser () then Format.printf "%a = -%a@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state
+ (Let (x, Prim (Extern "%int_neg", [Pv y])) :: instrs)
+ | ADDINT ->
let y = State.accu state in
let z = State.peek 0 state in
- let (x', state) = State.fresh_var state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a + %a@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Prim (WrapInt, [Pv x'])) ::
- Let (x', Prim (Extern "%int_add", [Pv y; Pv z])) :: instrs)
- | SUBINT ->
+ if debug_parser () then Format.printf "%a = %a + %a@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Prim (Extern "%int_add", [Pv y; Pv z])) :: instrs)
+ | SUBINT ->
let y = State.accu state in
let z = State.peek 0 state in
- let (x', state) = State.fresh_var state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a - %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
- (Let (x, Prim (WrapInt, [Pv x'])) ::
- Let (x', Prim (Extern "%int_sub", [Pv y; Pv z])) :: instrs)
- | MULINT ->
+ compile blocks code limit (pc + 1) (State.pop 1 state)
+ (Let (x, Prim (Extern "%int_sub", [Pv y; Pv z])) :: instrs)
+ | MULINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a * %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_mul", [Pv y; Pv z])) :: instrs)
- | DIVINT ->
+ | DIVINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a / %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_div", [Pv y; Pv z])) :: instrs)
- | MODINT ->
+ | MODINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a %% %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_mod", [Pv y; Pv z])) :: instrs)
- | ANDINT ->
+ | ANDINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a & %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_and", [Pv y; Pv z])) :: instrs)
- | ORINT ->
+ | ORINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a | %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_or", [Pv y; Pv z])) :: instrs)
- | XORINT ->
+ | XORINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a ^ %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_xor", [Pv y; Pv z])) :: instrs)
- | LSLINT ->
+ | LSLINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a << %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_lsl", [Pv y; Pv z])) :: instrs)
- | LSRINT ->
+ | LSRINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a >>> %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_lsr", [Pv y; Pv z])) :: instrs)
- | ASRINT ->
+ | ASRINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then
+ if debug_parser () then
Format.printf "%a = %a >> %a@." Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Extern "%int_asr", [Pv y; Pv z])) :: instrs)
- | EQ ->
+ | EQ ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a == %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a == %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Eq, [Pv y; Pv z])) :: instrs)
- | NEQ ->
+ | NEQ ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a != %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a != %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Neq, [Pv y; Pv z])) :: instrs)
- | LTINT ->
+ | LTINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a < %a)@." Var.print x
- Var.print y Var.print (State.peek 0 state);
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a < %a)@." Var.print x
+ Var.print y Var.print (State.peek 0 state);
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Lt, [Pv y; Pv z])) :: instrs)
- | LEINT ->
+ | LEINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a <= %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a <= %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Le, [Pv y; Pv z])) :: instrs)
- | GTINT ->
+ | GTINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a > %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a > %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Lt, [Pv z; Pv y])) :: instrs)
- | GEINT ->
+ | GEINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a >= %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a >= %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Le, [Pv z; Pv y])) :: instrs)
- | OFFSETINT ->
- let n = gets code (pc + 1) in
+ | OFFSETINT ->
+ let n = gets32 code (pc + 1) in
let y = State.accu state in
let (z, state) = State.fresh_var state in
- let (x', state) = State.fresh_var state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = %a + %d@." Var.print x Var.print y n;
- compile code limit (pc + 2) state
- (Let (x, Prim (WrapInt, [Pv x'])) ::
- Let (x', Prim (Extern "%int_add", [Pv y; Pv z])) ::
+ if debug_parser () then Format.printf "%a = %a + %ld@." Var.print x Var.print y n;
+ compile blocks code limit (pc + 2) state
+ (Let (x, Prim (Extern "%int_add", [Pv y; Pv z])) ::
Let (z, Const n) :: instrs)
- | OFFSETREF ->
+ | OFFSETREF ->
let n = gets code (pc + 1) in
let x = State.accu state in
- if debug () then Format.printf "%a += %d@." Var.print x n;
+ if debug_parser () then Format.printf "%a += %d@." Var.print x n;
let instrs = Offset_ref (x, n) :: instrs in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "x = 0@.";
- compile code limit (pc + 2) state (Let (x, Const 0) :: instrs)
- | ISINT ->
+ if debug_parser () then Format.printf "x = 0@.";
+ compile blocks code limit (pc + 2) state (Let (x, Const 0l) :: instrs)
+ | ISINT ->
let y = State.accu state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = !%a@." Var.print x Var.print y;
- compile code limit (pc + 1) state (Let (x, Prim (IsInt, [Pv y])) :: instrs)
- | BEQ ->
- let n = gets code (pc + 1) in
+ if debug_parser () then Format.printf "%a = !%a@." Var.print x Var.print y;
+ compile blocks code limit (pc + 1) state (Let (x, Prim (IsInt, [Pv y])) :: instrs)
+ | BEQ ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CEq n, x, (pc + offset + 2, args), (pc + 3, args)), state)
- | BNEQ ->
- let n = gets code (pc + 1) in
+ | BNEQ ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CEq n, x, (pc + 3, args), (pc + offset + 2, args)), state)
- | BLTINT ->
- let n = gets code (pc + 1) in
+ | BLTINT ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CLt n, x, (pc + offset + 2, args), (pc + 3, args)), state)
- | BLEINT ->
- let n = gets code (pc + 1) in
+ | BLEINT ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CLe n, x, (pc + offset + 2, args), (pc + 3, args)), state)
- | BGTINT ->
- let n = gets code (pc + 1) in
+ | BGTINT ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CLe n, x, (pc + 3, args), (pc + offset + 2, args)), state)
- | BGEINT ->
- let n = gets code (pc + 1) in
+ | BGEINT ->
+ let n = gets32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CLt n, x, (pc + 3, args), (pc + offset + 2, args)), state)
- | BULTINT ->
- let n = getu code (pc + 1) in
+ | BULTINT ->
+ let n = getu32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CUlt n, x, (pc + offset + 2, args), (pc + 3, args)), state)
- | BUGEINT ->
- let n = getu code (pc + 1) in
+ | BUGEINT ->
+ let n = getu32 code (pc + 1) in
let offset = gets code (pc + 2) in
let x = State.accu state in
let args = State.stack_vars state in
(instrs,
Cond (CUlt n, x, (pc + 3, args), (pc + offset + 2, args)), state)
- | ULTINT ->
+ | ULTINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a <= %a) (unsigned)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a <= %a) (unsigned)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Ult, [Pv y; Pv z])) :: instrs)
- | UGEINT ->
+ | UGEINT ->
let y = State.accu state in
let z = State.peek 0 state in
let (x, state) = State.fresh_var state in
- if debug () then Format.printf "%a = mk_bool(%a >= %a)@."
- Var.print x Var.print y Var.print z;
- compile code limit (pc + 1) (State.pop 1 state)
+ if debug_parser () then Format.printf "%a = mk_bool(%a >= %a)@."
+ Var.print x Var.print y Var.print z;
+ compile blocks code limit (pc + 1) (State.pop 1 state)
(Let (x, Prim (Ult, [Pv z; Pv y])) :: instrs)
- | GETPUBMET ->
-(*FIX: should cache*)
- let n = gets code (pc + 1) in
+ | GETPUBMET ->
+ let n = gets32 code (pc + 1) in
+ let cache = !method_cache_id in
+ incr method_cache_id;
let obj = State.accu state in
let state = State.push state in
let (tag, state) = State.fresh_var state in
let (m, state) = State.fresh_var state in
-if debug () then Format.printf "%a = %d@." Var.print tag n;
-if debug () then Format.printf "%a = caml_get_public_method(%a, %a)@."
- Var.print m Var.print obj Var.print tag;
- compile code limit (pc + 3) state
- (Let (m, Prim (Extern "caml_get_public_method", [Pv obj; Pv tag])) ::
+ if debug_parser () then Format.printf "%a = %ld@." Var.print tag n;
+ if debug_parser () then Format.printf "%a = caml_get_public_method(%a, %a)@."
+ Var.print m Var.print obj Var.print tag;
+ compile blocks code limit (pc + 3) state
+ (Let (m, Prim (Extern "caml_get_public_method",
+ [Pv obj; Pv tag; Pc (Int (Int32.of_int cache))])) ::
Let (tag, Const n) :: instrs)
- | GETDYNMET ->
+ | GETDYNMET ->
let tag = State.accu state in
let obj = State.peek 0 state in
let (m, state) = State.fresh_var state in
-if debug () then Format.printf "%a = caml_get_public_method(%a, %a)@."
- Var.print m Var.print obj Var.print tag;
- compile code limit (pc + 1) state
- (Let (m, Prim (Extern "caml_get_public_method", [Pv obj; Pv tag])) ::
+ if debug_parser () then Format.printf "%a = caml_get_public_method(%a, %a)@."
+ Var.print m Var.print obj Var.print tag;
+ compile blocks code limit (pc + 1) state
+ (Let (m, Prim (Extern "caml_get_public_method",
+ [Pv obj; Pv tag; Pc (Int 0l)])) ::
instrs)
- | GETMETHOD ->
+ | GETMETHOD ->
let lab = State.accu state in
let obj = State.peek 0 state in
let (meths, state) = State.fresh_var state in
let (m, state) = State.fresh_var state in
-if debug () then Format.printf "%a = lookup(%a, %a)@."
- Var.print m Var.print obj Var.print lab;
- compile code limit (pc + 1) state
+ if debug_parser () then Format.printf "%a = lookup(%a, %a)@."
+ Var.print m Var.print obj Var.print lab;
+ compile blocks code limit (pc + 1) state
(Let (m, Prim (Array_get, [Pv meths; Pv lab])) ::
Let (meths, Field (obj, 0)) :: instrs)
- | STOP ->
+ | STOP ->
(instrs, Stop, state)
end
@@ -1511,14 +1593,14 @@
let block = AddrMap.find pc blocks in
match block.branch with
Return _ | Raise _ | Stop ->
- accu
+ accu
| Branch (pc', _) | Poptrap (pc', _) ->
- f pc' accu
+ f pc' accu
| Cond (_, _, (pc1, _), (pc2, _)) | Pushtrap ((pc1, _), _, (pc2, _), _) ->
- f pc1 accu >> f pc1 >> f pc2
+ f pc1 accu >> f pc1 >> f pc2
| Switch (_, a1, a2) ->
- accu >> Array.fold_right (fun (pc, _) accu -> f pc accu) a1
- >> Array.fold_right (fun (pc, _) accu -> f pc accu) a2
+ accu >> Array.fold_right (fun (pc, _) accu -> f pc accu) a1
+ >> Array.fold_right (fun (pc, _) accu -> f pc accu) a2
let rec traverse blocks pc visited blocks' =
if not (AddrSet.mem pc visited) then begin
@@ -1537,14 +1619,14 @@
raised in the [try ... with ...] body. *)
match block.branch, path with
Pushtrap (cont1, x, cont2, _), pc3 :: rem ->
- (AddrMap.add
- pc { block with branch = Pushtrap (cont1, x, cont2, pc3) }
- blocks',
- rem)
+ (AddrMap.add
+ pc { block with branch = Pushtrap (cont1, x, cont2, pc3) }
+ blocks',
+ rem)
| Poptrap (pc, _), _ ->
- (blocks', pc :: path)
+ (blocks', pc :: path)
| _ ->
- (blocks', path)
+ (blocks', path)
in
(visited, blocks', path)
end else
@@ -1560,22 +1642,15 @@
(****)
-let is_toplevel = ref false
-
-let build_toplevel () = is_toplevel := true
-
-let set_global x v rem =
- let globals = Var.fresh () in
- Let (globals,
- Prim (Extern "caml_js_var", [Pc (String "caml_global_data")])) ::
- Let (Var.fresh (),
- Prim (Extern "caml_js_set", [Pv globals; Pc (String x); Pv v])) ::
- rem
-
-let parse_bytecode code state standalone_info =
+let parse_bytecode ?(debug=`No) code globals =
+ let state = State.initial globals in
Code.Var.reset ();
- analyse_blocks code;
- compile_block code 0 state;
+ let blocks = Blocks.analyse code in
+ let blocks =
+ if debug = `Full
+ then Debug.fold (fun pc _ blocks -> Blocks.add blocks pc) blocks
+ else blocks in
+ compile_block blocks code 0 state;
let blocks =
AddrMap.mapi
@@ -1589,106 +1664,65 @@
tagged_blocks := AddrSet.empty;
let free_pc = String.length code / 4 in
- let g = State.globals state in
- let body =
- match standalone_info with
- Some (symb, crcs, prim, paths) ->
- let l = ref [] in
-
- let register_global n =
- l :=
- let x = Var.fresh () in
- Let (x, Const n) ::
- Let (Var.fresh (),
- Prim (Extern "caml_register_global",
- [Pv x ; Pv (access_global g n)])) ::
- !l
- in
- register_global 2; (* Failure *)
- register_global 3; (* Invalid_argument *)
- register_global 5; (* Division_by_zero *)
- register_global 6; (* Not_found *)
- for i = Array.length g.constants - 1 downto 0 do
- match g.vars.(i) with
- Some x when g.is_const.(i) ->
- if g.is_exported.(i) then register_global i;
- l := Let (x, Constant (parse_const g.constants.(i))) :: !l
- | _ ->
- ()
- done;
- if !is_toplevel then begin
- (* Include linking information *)
- let toc =
- [("SYMB", Obj.repr symb); ("CRCS", crcs); ("PRIM", Obj.repr prim)]
- in
- l :=
- (let x = Var.fresh () in
- Let (x, Constant (parse_const (Obj.repr toc))) ::
- set_global "toc" x !l);
- (* Include interface files *)
- let fields = ref [] in
- Tbl.iter
- (fun id num ->
- if id.Ident.flags = 1 then begin
- let name = String.uncapitalize id.Ident.name ^ ".cmi" in
- let file =
- try
- Util.find_in_paths paths name
- with Not_found ->
- Format.eprintf "%s: interface file '%s' not found@."
- Sys.argv.(0) name;
- exit 1
- in
- let s = Util.read_file file in
- fields := Pc (String name) :: Pc (String s) :: !fields
- end) symb.num_tbl;
- l :=
- (let x = Var.fresh () in
- Let (x, Prim (Extern "%object_literal", !fields)) ::
- set_global "interfaces" x !l)
- end;
-
- !l
- | None ->
- let globals = Var.fresh () in
- let l =
- ref [Let (globals,
- Prim (Extern "caml_js_var",
- [Pc (String "caml_global_data")]))]
- in
- for i = 0 to Array.length g.vars - 1 do
- match g.vars.(i) with
- Some x when g.is_const.(i) ->
- l := Let (x, Field (globals, i)) :: !l
- | _ ->
- ()
- done;
- List.rev !l
- in
- let last = Branch (0, []) in
- let pc = free_pc in
- let blocks =
- AddrMap.add free_pc
- { params = []; handler = None; body = body; branch = last }
- blocks
- in
- let free_pc = free_pc + 1 in
- let blocks = match_exn_traps (pc, blocks, free_pc) in
- let debug pc =
- Debug.find_loc pc
- in
- ((pc, blocks, free_pc), debug)
+ let blocks = match_exn_traps (0, blocks, free_pc) in
+ (0, blocks, free_pc)
-(****)
-exception Bad_magic_number
+(* HACK 1 - fix bytecode *)
+
+let orig_code_bytes =
+ [`I PUSHCONSTINT; `C 31;
+ `I PUSHCONST1;
+ `I LSLINT;
+ `I BNEQ; `C 0; `C 5; (* overwrite from here *)
+ `I CONSTINT; `C 30;
+ `I BRANCH; `C 3;
+ `I CONSTINT; `C 62;
+ `I PUSHCONST1;
+ `I LSLINT ]
+
+let fixed_code_bytes =
+ [`I CONSTINT; `C 31;
+ `I BRANCH; `C 6;
+ `I PUSHCONST1]
+
+let orig_code = Instr.compile orig_code_bytes
+let fixed_code = Instr.compile fixed_code_bytes
+
+let fix_min_max_int code =
+ begin
+ try
+ let i = Util.find orig_code code in
+ String.blit fixed_code 0 code (i + 16) (String.length fixed_code)
+ with Not_found ->
+ Format.eprintf
+ "Warning: could not fix min_int/max_int definition \
+ (bytecode not found).@."
+ end
+
+(* HACK 2 - override module *)
-let exec_magic_number = "Caml1999X008"
+let override_global =
+ let jsmodule name func =
+ Prim(Extern "%overrideMod",[Pc (String name);Pc (String func)]) in
+ [
+ "CamlinternalMod",(fun orig instrs ->
+ let x = Var.fresh () in
+ Var.name x "internalMod";
+ let init_mod = Var.fresh () in
+ let update_mod = Var.fresh () in
+ x, Let(x,Block(0,[| init_mod; update_mod |]))::
+ Let(init_mod,jsmodule "CamlinternalMod" "init_mod")::
+ Let(update_mod,jsmodule "CamlinternalMod" "update_mod")::
+ instrs)
+ ]
+
+(* HACK END *)
let seek_section toc ic name =
let rec seek_sec curr_ofs = function
- [] -> raise Not_found
- | (n, len) :: rem ->
+ [] -> raise Not_found
+ | (n, len) :: rem ->
if n = name
then begin seek_in ic (curr_ofs - len); len end
else seek_sec (curr_ofs - len) rem in
@@ -1698,9 +1732,9 @@
let pos_trailer = in_channel_length ic - 16 in
seek_in ic pos_trailer;
let num_sections = input_binary_int ic in
- let header = String.create(String.length exec_magic_number) in
- really_input ic header 0 (String.length exec_magic_number);
- if header <> exec_magic_number then raise Bad_magic_number;
+ let header = String.create Util.MagicNumber.size in
+ really_input ic header 0 Util.MagicNumber.size;
+ Util.MagicNumber.assert_current header;
seek_in ic (pos_trailer - 8 * num_sections);
let section_table = ref [] in
for i = 1 to num_sections do
@@ -1711,52 +1745,15 @@
done;
!section_table
-let read_primitive_table toc ic =
- let len = seek_section toc ic "PRIM" in
- let p = String.create len in
- really_input ic p 0 len;
- let rec split beg cur =
- if cur >= len then []
- else if p.[cur] = '\000' then
- String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
- else
- split beg (cur + 1) in
- Array.of_list(split 0 0)
-
-(****)
-
-let orig_code = Str.regexp_string
- ("\x6c\x00\x00\x00\x1f\x00\x00\x00" ^ (* pushconstint 31 *)
- "\x69\x00\x00\x00" ^ (* pushconst1 *)
- "\x76\x00\x00\x00" ^ (* lslint *)
- "\x84\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00" ^
- (* bneq +5 (overwrite from here) *)
- "\x67\x00\x00\x00\x1e\x00\x00\x00" ^ (* constint 30 *)
- "\x54\x00\x00\x00\x03\x00\x00\x00" ^ (* branch +3 *)
- "\x67\x00\x00\x00\x3e\x00\x00\x00" ^ (* constint 62 *)
- "\x69\x00\x00\x00" ^ (* pushconst1 *)
- "\x76\x00\x00\x00") (* lslint *)
-
-let fixed_code =
- "\x67\x00\x00\x00\x1f\x00\x00\x00" ^ (* constint 31 *)
- "\x54\x00\x00\x00\x06\x00\x00\x00" ^ (* branch +6 *)
- "\x69\x00\x00\x00" (* pushconst1 *)
+let from_channel ?(toplevel=false) ?(debug=`No) ic =
-let fix_min_max_int code =
- begin try
- let i = Str.search_forward orig_code code 0 in
- String.blit fixed_code 0 code (i + 16) (String.length fixed_code)
- with Not_found ->
- Format.eprintf
- "Warning: could not fix min_int/max_int definition \
- (bytecode not found).@."
- end
+ let toc = read_toc ic in
-(****)
+ let prim_size = seek_section toc ic "PRIM" in
+ let prim = String.create prim_size in
+ really_input ic prim 0 prim_size;
+ let primitive_table = Array.of_list(Util.split_char '\000' prim) in
-let from_channel ~paths ic =
- let toc = read_toc ic in
- let primitives = read_primitive_table toc ic in
let code_size = seek_section toc ic "CODE" in
let code = String.create code_size in
really_input ic code 0 code_size;
@@ -1767,33 +1764,106 @@
ignore(seek_section toc ic "SYMB");
let symbols = (input_value ic : Ident.t numtable) in
- if !keep_variable_names then begin
+ ignore(seek_section toc ic "CRCS");
+ let crcs = (input_value ic : Obj.t) in
+
+ if debug <> `No then begin
try
ignore(seek_section toc ic "DBUG");
Debug.read ic;
with Not_found -> ()
end;
- let globals = make_globals (Array.length init_data) init_data primitives in
- if !is_toplevel then begin
- Tbl.iter (fun _ n -> globals.is_exported.(n) <- true) symbols.num_tbl;
- Primitive.mark_used "caml_string_greaterthan"
- end;
-
- fix_min_max_int code;
+ (* We fix the bytecode to replace max_int/min_int *)
+ if Util.Version.v = `V3
+ then fix_min_max_int code;
+
+ let globals = make_globals (Array.length init_data) init_data primitive_table in
+
+ (* Initialize module override mechanism *)
+ List.iter (fun (name, v) ->
+ try
+ let nn = { Ident.stamp= 0; name; flags= 0 } in
+ let i = Tbl.find (fun x1 x2 -> String.compare x1.Ident.name x2.Ident.name) nn symbols.num_tbl in
+ globals.override.(i) <- Some v;
+ if debug_parser () then Format.eprintf "overriding global %s@." name
+ with Not_found -> ()
+ ) override_global;
+
+ if toplevel then
+ begin
+ (* export globals *)
+ Tbl.iter (fun _ n -> globals.is_exported.(n) <- true) symbols.num_tbl;
+ (* @vouillon: *)
+ (* we should then use the -linkall option to build the toplevel. *)
+ (* The OCaml compiler can generate code using this primitive but *)
+ (* does not use it itself. This is the only primitive in this case. *)
+ (* Ideally, Js_of_ocaml should parse the .mli files for primitives as *)
+ (* well as marking this primitive as potentially used. But *)
+ (* the -linkall option is probably good enough. *)
+ (* Primitive.mark_used "caml_string_greaterthan" *)
+ end;
+
+ let p = parse_bytecode ~debug code globals in
+
+ (* register predefined exception *)
+ let body = ref [] in
+ for i = 0 to 11 do (* see ocaml/byterun/fail.h *)
+ body := register_global ~force:true globals i !body;
+ globals.is_exported.(i) <- false;
+ done;
+ let body = Util.array_fold_right_i (fun i c l ->
+ match globals.vars.(i) with
+ Some x when globals.is_const.(i) ->
+ let l = register_global globals i l in
+ Let (x, Constant (Constants.parse globals.constants.(i))) :: l
+ | _ -> l) globals.constants !body in
- let state = State.initial globals in
- ignore(seek_section toc ic "CRCS");
- let crcs = (input_value ic : Obj.t) in
- let len = seek_section toc ic "PRIM" in
- let prim = String.create len in
- really_input ic prim 0 len;
+ let body =
+ if toplevel
+ then
+ begin
+ (* Include linking information *)
+ let toc = [
+ ("SYMB", Obj.repr symbols);
+ ("CRCS", crcs);
+ ("PRIM", Obj.repr prim)
+ ] in
+ let gdata = Var.fresh () in
+ let infos = [
+ "toc",(Constants.parse (Obj.repr toc));
+ "prim_count",(Int (Int32.of_int (Array.length globals.primitives)))] in
+ let body = List.fold_left (fun rem (name,const) ->
+ let c = Var.fresh () in
+ Let (c, Constant const) ::
+ Let (Var.fresh (),
+ Prim (Extern "caml_js_set", [Pv gdata; Pc (String name); Pv c])) ::
+ rem) body infos in
+ Let (gdata, Prim (Extern "caml_get_global_data", [])) :: body
+ end
+ else body in
- parse_bytecode code state (Some (symbols, crcs, prim, paths))
+ (* List interface files *)
+ let cmis =
+ if toplevel && Option.Optim.include_cmis ()
+ then Tbl.fold (fun id _num acc ->
+ if id.Ident.flags = 1
+ then Util.StringSet.add id.Ident.name acc
+ else acc) symbols.num_tbl Util.StringSet.empty
+ else Util.StringSet.empty in
+ prepend p body, cmis, Debug.find_loc
(* As input: list of primitives + size of global table *)
let from_string primitives code =
let globals = make_globals 0 [||] primitives in
- let state = State.initial globals in
- parse_bytecode code state None
+ let p = parse_bytecode code globals in
+
+ let gdata = Var.fresh () in
+ let body = Util.array_fold_right_i (fun i var l ->
+ match var with
+ | Some x when globals.is_const.(i) ->
+ Let (x, Field (gdata, i)) :: l
+ | _ -> l) globals.vars [] in
+ let body = Let (gdata, Prim (Extern "caml_get_global_data", [])) :: body in
+ prepend p body, Debug.find_loc
diff -Nru js-of-ocaml-1.4/compiler/parse_bytecode.mli js-of-ocaml-2.2/compiler/parse_bytecode.mli
--- js-of-ocaml-1.4/compiler/parse_bytecode.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_bytecode.mli 2014-05-15 08:37:39.000000000 +0000
@@ -18,12 +18,10 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-type debug_loc = int -> (string * int * int * int) option
+type debug_loc = Javascript.loc -> Parse_info.t option
-val from_channel : paths:string list -> in_channel -> Code.program * debug_loc
+val from_channel :
+ ?toplevel:bool -> ?debug:[`Full | `Names | `No] -> in_channel ->
+ Code.program * Util.StringSet.t * debug_loc
val from_string : string array -> string -> Code.program * debug_loc
-
-val set_pretty : unit -> unit
-
-val build_toplevel : unit -> unit
diff -Nru js-of-ocaml-1.4/compiler/parse_info.ml js-of-ocaml-2.2/compiler/parse_info.ml
--- js-of-ocaml-1.4/compiler/parse_info.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_info.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,139 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+type t = {
+ name : string;
+ col : int;
+ line : int;
+ idx : int;
+ fol : bool option;
+}
+
+let zero = {
+ name = "";
+ col = 0;
+ line = 0;
+ idx = 0;
+ fol = None
+}
+
+
+module Line_info = struct
+
+ type t = {
+ mutable acc_pos : int;
+ mutable acc_line : int;
+ lines : int array;
+ name : string;
+ }
+
+ let rec compute lines acc line pos =
+ if line >= Array.length lines
+ then
+ if pos = 0 then acc, line,0 else assert false
+ else
+ if lines.(line) >= pos
+ then acc, line, pos
+ else compute lines (acc + lines.(line) + 1) (succ line) (pos - lines.(line) - 1)
+
+ let get t pos =
+ let acc,line,pos =
+ if t.acc_pos <= pos
+ then
+ compute t.lines t.acc_pos t.acc_line (pos - t.acc_pos)
+ else
+ compute t.lines 0 0 pos
+ in
+ t.acc_pos <- acc;
+ t.acc_line <- line;
+ line,pos
+
+ let from_file file =
+ let ic = open_in file in
+ let lines = ref [] in
+ (try
+ while true do
+ lines:=String.length (input_line ic) :: !lines
+ done with End_of_file -> ());
+ let lines = Array.of_list (List.rev !lines) in
+ let t = {
+ acc_pos = 0;
+ acc_line = 0;
+ lines;
+ name=file;
+ } in
+ close_in ic;
+ t
+
+ let from_string str =
+ let pos = ref 0
+ and lines = ref [] in
+ (try
+ while true do
+ let idx = String.index_from str !pos '\n' in
+ lines:=(idx - !pos)::!lines;
+ pos:=idx+1;
+ done
+ with Not_found -> lines:= (String.length str - !pos) :: !lines);
+ let lines = Array.of_list (List.rev !lines) in
+ { acc_pos = 0;
+ acc_line = 0;
+ lines;
+ name=""}
+
+ let from_channel ic =
+ let buf = Buffer.create 1024 in
+ let lines = ref [] in
+ (try
+ while true do
+ let l = input_line ic in
+ Buffer.add_string buf l;
+ Buffer.add_char buf '\n';
+
+ lines:=String.length l :: !lines
+ done with End_of_file -> ());
+ let lines = Array.of_list (List.rev !lines) in
+ let t = {
+ acc_pos = 0;
+ acc_line = 0;
+ lines;
+ name="";
+ } in
+ t,Buffer.contents buf
+
+end
+
+type lineinfo = Line_info.t
+
+let make_lineinfo_from_file file = Line_info.from_file file
+
+let make_lineinfo_from_string str = Line_info.from_string str
+
+let make_lineinfo_from_channel c = Line_info.from_channel c
+
+let t_of_lexbuf line_info lexbuf : t =
+ let idx = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum in
+ let line,col = Line_info.get line_info idx in
+ {
+ fol = None;
+ idx;
+ line;
+ col;
+ name = line_info.Line_info.name;
+ }
diff -Nru js-of-ocaml-1.4/compiler/parse_info.mli js-of-ocaml-2.2/compiler/parse_info.mli
--- js-of-ocaml-1.4/compiler/parse_info.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_info.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,36 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+type t = {
+ name : string;
+ col : int;
+ line : int;
+ idx : int;
+ fol : bool option;
+}
+
+val zero : t
+
+type lineinfo
+
+val make_lineinfo_from_file : string -> lineinfo
+val make_lineinfo_from_string : string -> lineinfo
+val make_lineinfo_from_channel : in_channel -> lineinfo * string
+
+val t_of_lexbuf : lineinfo -> Lexing.lexbuf -> t
diff -Nru js-of-ocaml-1.4/compiler/parse_js.ml js-of-ocaml-2.2/compiler/parse_js.ml
--- js-of-ocaml-1.4/compiler/parse_js.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_js.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,170 @@
+(* Js_of_ocaml compiler
+ * Copyright (C) 2013 Hugo Heuzard
+ *)
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2010 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
+ * license.txt for more details.
+ *)
+
+let strip_comment l= List.filter (fun x -> not (Js_token.is_comment x)) l
+
+let rec until_non_comment acc = function
+ | [] -> acc,None
+ | x::xs ->
+ if Js_token.is_comment x
+ then until_non_comment (x::acc) xs
+ else (acc, Some (x,xs))
+
+let rec adjust_tokens ?(keep_comment=true) l = match until_non_comment [] l with
+ | acc,None when keep_comment -> List.rev acc
+ | _,None -> []
+ | past,Some (first,rest) ->
+ let open Js_token in
+ let f prev x acc = match prev, x with
+ (* restricted productions *)
+ (* 7.9.1 - 3 *)
+ (* When, as the program is parsed from left to right, a token is encountered *)
+ (* that is allowed by some production of the grammar, but the production *)
+ (* is a restricted production and the token would be the first token for a *)
+ (* terminal or nonterminal immediately following the annotation [no LineTerminator here] *)
+ (* within the restricted production (and therefore such a token is called a restricted token), *)
+ (* and the restricted token is separated from the previous token by at least *)
+ (* one LineTerminator, then a semicolon is automatically inserted before the *)
+ (* restricted token. *)
+ | (T_RETURN _ | T_CONTINUE _ | T_BREAK _ | T_THROW _),(T_SEMICOLON _ | T_VIRTUAL_SEMICOLON _) ->
+ x::acc
+ | (T_RETURN _ | T_CONTINUE _ | T_BREAK _ | T_THROW _),_ ->
+ let x' = Js_token.info_of_tok x in
+ let prev' = Js_token.info_of_tok prev in
+ if prev'.Parse_info.line <> x'.Parse_info.line
+ then x::(Js_token.T_VIRTUAL_SEMICOLON x')::acc
+ else x::acc
+ | _, _ -> x::acc in
+ let rec aux prev acc = function
+ | [] -> List.rev acc
+ | e::l ->
+ let nprev,nacc =
+ if Js_token.is_comment e
+ then if keep_comment then prev,(e::acc) else prev,acc
+ else e,(f prev e acc) in
+ aux nprev nacc l in
+ let past = if keep_comment then past else [] in
+ aux first (first::past) rest
+
+type lexer = Js_token.token list
+
+let lexer_aux ?(rm_comment=true) lines_info lexbuf =
+ let rec loop lexbuf extra lines_info prev acc =
+ let tokinfo lexbuf =
+ let pi = Parse_info.t_of_lexbuf lines_info lexbuf in
+ let pi = match prev with
+ | None -> { pi with Parse_info.fol=Some true}
+ | Some prev ->
+ let prev_pi = Js_token.info_of_tok prev in
+ if prev_pi.Parse_info.line <> pi.Parse_info.line
+ then {pi with Parse_info.fol=Some true}
+ else pi in
+ match extra with
+ | None -> pi
+ | Some (file,offset) ->
+ { pi with Parse_info.name = file;
+ line = pi.Parse_info.line - offset } in
+ let t = Js_lexer.initial tokinfo prev lexbuf in
+ match t with
+ | Js_token.EOF _ -> List.rev acc
+ | _ ->
+ let extra = match t with
+ | Js_token.TComment (ii,cmt) when String.length cmt > 1 && cmt.[0] = '#' ->
+ let lexbuf = Lexing.from_string cmt in
+ begin
+ try
+ let file,line = Js_lexer.pos lexbuf in
+ match extra with
+ | None -> Some (file, ii.Parse_info.line - ( line - 1))
+ | Some (_,offset) -> Some (file, ii.Parse_info.line - (line - 1) + offset)
+ with _ -> extra end
+ | _ -> extra in
+ let prev =
+ if Js_token.is_comment t
+ then prev
+ else Some t in
+ loop lexbuf extra lines_info prev (t::acc)
+ in
+ let toks = loop lexbuf None lines_info None [] in
+ (* hack: adjust tokens *)
+ adjust_tokens ~keep_comment:(not rm_comment) toks
+
+let lexer_from_file ?rm_comment file : lexer =
+ let lines_info = Parse_info.make_lineinfo_from_file file in
+ let ic = open_in file in
+ let lexbuf = Lexing.from_channel ic in
+ lexer_aux ?rm_comment lines_info lexbuf
+
+let lexer_from_channel ?rm_comment ci : lexer =
+ let lines_info,str = Parse_info.make_lineinfo_from_channel ci in
+ let lexbuf = Lexing.from_string str in
+ lexer_aux ?rm_comment lines_info lexbuf
+
+let lexer_from_string ?rm_comment str : lexer =
+ let lines_info = Parse_info.make_lineinfo_from_string str in
+ let lexbuf = Lexing.from_string str in
+ lexer_aux ?rm_comment lines_info lexbuf
+
+let lexer_map = List.map
+let lexer_fold f acc l = List.fold_left f acc l
+let lexer_filter f l = List.filter f l
+let lexer_from_list l = adjust_tokens l
+
+exception Parsing_error of Parse_info.t
+
+type st = {
+ mutable rest : Js_token.token list;
+ mutable current : Js_token.token ;
+ mutable passed : Js_token.token list;
+ mutable eof : bool }
+
+let parse_aux the_parser toks =
+ let state = match toks with
+ | [] -> {
+ rest = [];
+ passed = [];
+ current = Js_token.EOF Parse_info.zero;
+ eof = false }
+ | hd :: _ -> {
+ rest = toks;
+ passed = [];
+ current = hd ;
+ eof = false } in
+ let lexer_fun lb =
+ match state.rest with
+ | [] when not state.eof ->
+ state.eof <- true;
+ let info = Js_token.info_of_tok state.current in
+ Js_token.EOF info
+ | [] -> assert false
+ | x::tl ->
+ state.rest <- tl;
+ state.current <- x;
+ state.passed <- x::state.passed;
+ x in
+ let lexbuf = Lexing.from_string "" in
+ try the_parser lexer_fun lexbuf
+ with
+ | Js_parser.Error
+ | Parsing.Parse_error ->
+ let pi = Js_token.info_of_tok state.current in
+ raise (Parsing_error pi)
+
+let parse lex = parse_aux Js_parser.program lex
+
+let parse_expr lex = parse_aux Js_parser.standalone_expression lex
diff -Nru js-of-ocaml-1.4/compiler/parse_js.mli js-of-ocaml-2.2/compiler/parse_js.mli
--- js-of-ocaml-1.4/compiler/parse_js.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/parse_js.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,38 @@
+
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+
+
+type lexer
+
+exception Parsing_error of Parse_info.t
+
+val strip_comment : lexer -> lexer
+
+val lexer_from_file : ?rm_comment:bool -> string -> lexer
+val lexer_from_string : ?rm_comment:bool -> string -> lexer
+val lexer_from_channel : ?rm_comment:bool -> in_channel -> lexer
+val lexer_map : (Js_token.token -> Js_token.token) -> lexer -> lexer
+val lexer_fold : ('a -> Js_token.token -> 'a) -> 'a -> lexer -> 'a
+val lexer_filter : (Js_token.token -> bool) -> lexer -> lexer
+val lexer_from_list : Js_token.token list -> lexer
+
+val parse : lexer -> Javascript.program
+val parse_expr : lexer -> Javascript.expression
diff -Nru js-of-ocaml-1.4/compiler/phisimpl.ml js-of-ocaml-2.2/compiler/phisimpl.ml
--- js-of-ocaml-1.4/compiler/phisimpl.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/phisimpl.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,7 +18,7 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let times = Util.debug "times"
+let times = Option.Debug.find "times"
open Code
diff -Nru js-of-ocaml-1.4/compiler/pretty_print.ml js-of-ocaml-2.2/compiler/pretty_print.ml
--- js-of-ocaml-1.4/compiler/pretty_print.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/pretty_print.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,11 +18,17 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
+type pos = {
+ mutable p_line : int;
+ mutable p_col : int
+}
+
type elt =
Text of string
| Break of string * int
| Start_group of int
| End_group
+ | Set_pos of pos
type t =
{ mutable indent : int;
@@ -37,20 +43,44 @@
mutable w : int;
mutable compact : bool;
+
+ mutable needed_space : (char -> char -> bool) option;
+ mutable pending_space : string option;
+ mutable last_char : char option;
+ mutable line : int;
+ mutable col : int;
+ mutable total : int;
output : string -> int -> int -> unit }
let spaces = String.make 80 ' '
+let output st s l =
+ (try
+ let last = String.rindex_from s (l-1) '\n' in
+ let line = ref 0 in
+ for i = 0 to l-1 do
+ if s.[i] = '\n' then incr line;
+ done;
+ st.line <- st.line + !line;
+ st.col <- l - last
+ with Not_found -> st.col <- l + st.col);
+ st.total <- st.total + String.length s;
+ st.output s 0 l
+
let rec output_spaces st n =
- st.output spaces 0 (min n 80);
+ output st spaces (min n 80);
if n > 80 then output_spaces st (n - 80)
-let output_newline st = st.output "\n" 0 1
+let output_newline st = output st "\n" 1
let rec flat_render st l =
match l with
Text s :: r | Break (s, _) :: r ->
- st.output s 0 (String.length s); flat_render st r
+ output st s (String.length s); flat_render st r
+ | Set_pos p :: r ->
+ p.p_line <- st.line;
+ p.p_col <- st.col;
+ flat_render st r
| _ :: r ->
flat_render st r
| [] ->
@@ -61,8 +91,11 @@
(* Vertical rendering *)
match e with
Text s ->
- st.output s 0 (String.length s);
+ output st s (String.length s);
st.cur <- st.cur + String.length s
+ | Set_pos p ->
+ p.p_line <- st.line;
+ p.p_col <- st.col
| Break (_, offs) ->
output_newline st;
let indent = st.box_indent + offs in
@@ -93,6 +126,7 @@
st.n <- 0;
List.iter (fun e -> push st e) l
end
+ | Set_pos _ -> ()
| Start_group _ ->
st.n <- st.n + 1
| End_group ->
@@ -110,16 +144,39 @@
(****)
let string st s =
- if st.compact then st.output s 0 (String.length s) else push st (Text s)
+ if st.compact then (
+ let len = (String.length s) in
+ if len <> 0
+ then begin
+ (match st.pending_space with
+ | None -> ()
+ | Some sp ->
+ begin
+ st.pending_space <- None;
+ match st.last_char,st.needed_space with
+ | Some last,Some f ->
+ if f last s.[0]
+ then output st sp 1
+ | _, None -> output st sp 1
+ | _ ->()
+ end);
+
+ output st s len;
+ st.last_char <- Some (s.[len-1])
+ end
+ )
+ else push st (Text s)
let genbreak st s n =
- if st.compact then st.output s 0 (String.length s) else push st (Break (s, n))
+ if not st.compact then push st (Break (s, n))
let break_token = Break ("", 0)
let break st = if not st.compact then push st break_token
+let break1 st = if not st.compact then push st (Break ("", 1))
-let space_token = Break (" ", 0)
-let space st = if st.compact then st.output " " 0 1 else push st space_token
+let non_breaking_space_token = Text " "
+let non_breaking_space st = if st.compact then st.pending_space <- Some " " else push st non_breaking_space_token
+let space ?(indent=0) st = if st.compact then st.pending_space <- Some "\n" else push st (Break (" ", indent))
let start_group st n = if not st.compact then push st (Start_group n)
let end_group st = if not st.compact then push st End_group
@@ -145,6 +202,19 @@
*)
+let total t = t.total
+
+let pos t =
+ if t.compact
+ then {
+ p_line = t.line;
+ p_col = t.col
+ }
+ else
+ let p = { p_line = -1 ; p_col = -1 } in
+ push t (Set_pos p);
+ p
+
let newline st =
output_newline st;
st.indent <- 0; st.box_indent <- 0; st.prev_indents <- [];
@@ -153,11 +223,17 @@
let to_out_channel ch =
{ indent = 0; box_indent = 0; prev_indents = [];
limit = 78; cur = 0; l = []; n = 0; w = 0;
- compact = false; output = fun s i l -> output ch s i l }
+ col = 0; line = 0; total = 0;
+ compact = false; pending_space = None; last_char = None; needed_space = None;
+ output = fun s i l -> Pervasives.output ch s i l }
let to_buffer b =
{ indent = 0; box_indent = 0; prev_indents = [];
limit = 78; cur = 0; l = []; n = 0; w = 0;
- compact = false; output = fun s i l -> Buffer.add_substring b s i l }
+ col = 0; line = 0; total = 0;
+ compact = false; pending_space = None; last_char = None; needed_space = None;
+ output = fun s i l -> Buffer.add_substring b s i l }
let set_compact st v = st.compact <- v
+
+let set_needed_space_function st f = st.needed_space <- Some f
diff -Nru js-of-ocaml-1.4/compiler/pretty_print.mli js-of-ocaml-2.2/compiler/pretty_print.mli
--- js-of-ocaml-1.4/compiler/pretty_print.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/pretty_print.mli 2014-05-15 08:37:39.000000000 +0000
@@ -20,11 +20,18 @@
type t
+type pos = {
+ mutable p_line : int;
+ mutable p_col : int
+}
+
val string : t -> string -> unit
val genbreak : t -> string -> int -> unit
val break : t -> unit
-val space : t -> unit
+val break1 : t -> unit
+val non_breaking_space : t -> unit
+val space : ?indent:int -> t -> unit
val start_group : t -> int -> unit
val end_group : t -> unit
@@ -33,5 +40,8 @@
val to_out_channel : out_channel -> t
val to_buffer : Buffer.t -> t
+val pos : t -> pos
+val total : t -> int
val set_compact : t -> bool -> unit
+val set_needed_space_function : t -> (char -> char -> bool) -> unit
diff -Nru js-of-ocaml-1.4/compiler/primitive.ml js-of-ocaml-2.2/compiler/primitive.ml
--- js-of-ocaml-1.4/compiler/primitive.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/primitive.ml 2014-05-15 08:37:39.000000000 +0000
@@ -20,30 +20,50 @@
let aliases = Hashtbl.create 17
-let alias nm nm' = Hashtbl.add aliases nm nm'
let rec resolve nm = try resolve (Hashtbl.find aliases nm) with Not_found -> nm
(****)
type kind = [ `Pure | `Mutable | `Mutator ]
+type kind_arg = [`Shallow_const | `Const | `Mutable]
+type t = [
+ | `Requires of Parse_info.t option * string list
+ | `Provides of Parse_info.t option * string * kind * kind_arg list option
+ | `Version of Parse_info.t option * ((int -> int -> bool) * string) list
+]
let kinds = Hashtbl.create 37
+let kind_args_tbl = Hashtbl.create 37
+let arities = Hashtbl.create 37
-let register p k = Hashtbl.add kinds p k
let kind nm = try Hashtbl.find kinds (resolve nm) with Not_found -> `Mutator
+let kind_args nm = try Some (Hashtbl.find kind_args_tbl (resolve nm)) with Not_found -> None
+
+let arity nm = Hashtbl.find arities (resolve nm)
+
let is_pure nm = kind nm <> `Mutator
-(****)
+let exists p = Hashtbl.mem kinds p
+
+open Util
+
+let externals = ref StringSet.empty
+
+let add_external name = externals := StringSet.add name !externals
-let primitives = ref Util.StringSet.empty
+let is_external name = StringSet.mem name !externals
-let mark_used nm =
- primitives := Util.StringSet.add nm !primitives
+let get_external () = !externals
-let list_used () =
- Format.eprintf "Primitives:@.";
- Util.StringSet.iter (fun nm -> Format.eprintf " %s@." nm) !primitives
+let register p k kargs arity =
+ add_external p;
+ (match arity with Some a -> Hashtbl.add arities p a | _ -> ());
+ (match kargs with Some k -> Hashtbl.add kind_args_tbl p k | _ -> ());
+ Hashtbl.add kinds p k
-let get_used () = Util.StringSet.elements !primitives
+let alias nm nm' =
+ add_external nm';
+ add_external nm;
+ Hashtbl.add aliases nm nm'
diff -Nru js-of-ocaml-1.4/compiler/primitive.mli js-of-ocaml-2.2/compiler/primitive.mli
--- js-of-ocaml-1.4/compiler/primitive.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/primitive.mli 2014-05-15 08:37:39.000000000 +0000
@@ -19,15 +19,24 @@
*)
val is_pure : string -> bool
-
-val mark_used : string -> unit
-val list_used : unit -> unit
-val get_used : unit -> string list
+val exists : string -> bool
type kind = [ `Pure | `Mutable | `Mutator ]
+type kind_arg = [`Shallow_const | `Const | `Mutable]
+type t =
+ [ `Requires of Parse_info.t option * string list
+ | `Provides of Parse_info.t option * string * kind * kind_arg list option
+ | `Version of Parse_info.t option * ((int -> int -> bool) * string) list ]
val kind : string -> kind
-val register : string -> kind -> unit
+val kind_args : string -> kind_arg list option
+val register : string -> kind -> kind_arg list option -> int option -> unit
+
+val arity : string -> int
val alias : string -> string -> unit
val resolve : string -> string
+
+val add_external : string -> unit
+val is_external : string -> bool
+val get_external : unit -> Util.StringSet.t
diff -Nru js-of-ocaml-1.4/compiler/pseudoFs.ml js-of-ocaml-2.2/compiler/pseudoFs.ml
--- js-of-ocaml-1.4/compiler/pseudoFs.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/pseudoFs.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,123 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let expand_path exts real virt =
+ let rec loop realfile virtfile acc =
+ if try Sys.is_directory realfile with _ -> false
+ then
+ Array.fold_left (fun acc s ->
+ loop (Filename.concat realfile s) (Filename.concat virtfile s) acc)
+ acc (Sys.readdir realfile)
+ else
+ try
+ let exmatch =
+ try
+ let b = Filename.basename realfile in
+ let i = String.rindex b '.' in
+ let e = String.sub b (i+1) (String.length b - i - 1) in
+ List.mem e exts
+ with Not_found -> List.mem "" exts
+ in
+ if exts = [] || exmatch
+ then (virtfile, realfile) :: acc
+ else acc
+ with exc ->
+ Format.eprintf "ignoring %s: %s@." realfile (Printexc.to_string exc);
+ acc
+ in loop real virt []
+
+let list_files name paths =
+ let name,dir = try
+ let i = String.index name ':' in
+ let d = String.sub name (i + 1) (String.length name - i - 1) in
+ let n = String.sub name 0 i in
+ if String.length d > 0 && d.[0] <> '/'
+ then failwith (Printf.sprintf "path '%s' for file '%s' must be absolute" d n);
+ let d =
+ if d.[String.length d - 1] <> '/'
+ then d^Filename.dir_sep
+ else d in
+ n,d
+ with Not_found ->
+ (* by default, files are store in /static/ directory *)
+ name,"/static/" in
+ let name, exts (* extensions filter *) =
+ try
+ let i = String.index name '=' in
+ let exts = String.sub name (i + 1) (String.length name - i - 1) in
+ let n = String.sub name 0 i in
+ let exts = Util.split_char ',' exts in
+ n,exts
+ with Not_found ->
+ name,[] in
+ let file =
+ try
+ Util.find_in_paths paths name
+ with Not_found ->
+ failwith (Printf.sprintf "file '%s' not found" name)
+ in
+ expand_path exts file (Filename.concat dir name)
+
+let cmi_dir = "/cmis"
+
+let find_cmi paths base =
+ try
+ let name = String.uncapitalize base ^ ".cmi" in
+ Filename.concat cmi_dir name, Util.find_in_paths paths name
+ with Not_found ->
+ let name = String.capitalize base ^ ".cmi" in
+ Filename.concat cmi_dir name, Util.find_in_paths paths name
+
+
+open Util
+open Code
+
+let read name filename =
+ let content = Util.read_file filename in
+ (Pc (IString name),Pc (IString content))
+
+let make_body prim cmis files paths =
+ let fs = StringSet.fold (fun s acc ->
+ try
+ let name, filename = find_cmi paths s in
+ read name filename :: acc
+ with Not_found ->
+ failwith (Printf.sprintf "interface file '%s' not found" s)
+ ) cmis [] in
+ let fs = List.fold_left (fun acc f ->
+ let l = list_files f paths in
+ List.fold_left (fun acc (n,fn) -> read n fn :: acc) acc l
+ ) fs files
+ in
+ let body = List.map (fun (n, c) -> Let(Var.fresh (), Prim(Extern prim, [n;c]))) fs in
+ body
+
+let f p cmis files paths =
+ let body = make_body "caml_fs_register" cmis files paths in
+ Code.prepend p body
+
+let f_empty cmis files paths =
+ let body = make_body "caml_fs_register_extern" cmis files paths in
+ let pc = 0 in
+ let blocks = AddrMap.add pc {params=[];
+ handler=None;
+ body=[];
+ branch=Stop} AddrMap.empty in
+ let p = pc, blocks, pc+1 in
+ Code.prepend p body
diff -Nru js-of-ocaml-1.4/compiler/pseudoFs.mli js-of-ocaml-2.2/compiler/pseudoFs.mli
--- js-of-ocaml-1.4/compiler/pseudoFs.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/pseudoFs.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,23 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Util
+
+val f : Code.program -> StringSet.t -> string list -> string list -> Code.program
+val f_empty : StringSet.t -> string list -> string list -> Code.program
diff -Nru js-of-ocaml-1.4/compiler/pure_fun.ml js-of-ocaml-2.2/compiler/pure_fun.ml
--- js-of-ocaml-1.4/compiler/pure_fun.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/pure_fun.ml 2014-05-15 08:37:39.000000000 +0000
@@ -26,12 +26,8 @@
match e with
Const _ | Block _ | Field _ | Closure _ | Constant _ ->
true
- | Apply (f, l, n) ->
- begin match n with
- Some n -> let m = List.length l in
- m < n || (m = n && VarSet.mem f pure_funs)
- | None -> false
- end
+ | Apply (f, l, exact) ->
+ exact && VarSet.mem f pure_funs
| Prim (p, l) ->
match p with
Extern f -> Primitive.is_pure f
diff -Nru js-of-ocaml-1.4/compiler/reserved.ml js-of-ocaml-2.2/compiler/reserved.ml
--- js-of-ocaml-1.4/compiler/reserved.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/reserved.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,104 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Util
+
+let keyword = List.fold_left (fun acc x -> StringSet.add x acc)
+ StringSet.empty
+ [
+ (* keywork *)
+ "break";
+ "case"; "catch"; "continue";
+ "debugger";"default";"delete";"do";
+ "else";
+ "finally";"for";"function";
+ "if"; "in";"instanceof";
+ "new";
+ "return";
+ "switch";
+ "this"; "throw"; "try"; "typeof";
+ "var"; "void"; "while"; "with";
+
+ (* reserved for future use *)
+ "class"; "enum"; "export"; "extends"; "import"; "super";
+
+ "implements";"interface";
+ "let";
+ "package";"private";"protected";"public";
+ "static";
+ "yield";
+
+ (* other *)
+ "null";
+ "true";
+ "false";
+ "NaN";
+
+
+ "undefined";
+ "this";
+
+]
+
+
+let provided = List.fold_left (fun acc x -> StringSet.add x acc)
+ StringSet.empty
+ [
+
+ "event";
+ "location";
+ "window";
+ "document";
+ "eval";
+ "navigator";
+ "self";
+
+ "Array";
+ "Date";
+ "Math";
+ "JSON";
+ "Object";
+ "RegExp";
+ "String";
+ "Boolean";
+ "Number";
+
+ "Infinity";
+ "isFinite";
+
+ "ActiveXObject";
+ "XMLHttpRequest";
+ "XDomainRequest";
+
+ "DOMException";
+ "Error";
+ "SyntaxError";
+ "arguments";
+
+ "decodeURI";
+ "decodeURIComponent";
+ "encodeURI";
+ "encodeURIComponent";
+ "escape";
+ "unescape";
+
+ "isNaN";
+ "parseFloat";
+ "parseInt";
+]
diff -Nru js-of-ocaml-1.4/compiler/reserved.mli js-of-ocaml-2.2/compiler/reserved.mli
--- js-of-ocaml-1.4/compiler/reserved.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/reserved.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,21 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val keyword : Util.StringSet.t
+val provided : Util.StringSet.t
diff -Nru js-of-ocaml-1.4/compiler/source_map.ml js-of-ocaml-2.2/compiler/source_map.ml
--- js-of-ocaml-1.4/compiler/source_map.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/source_map.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,101 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+type map = {
+ gen_line : int;
+ gen_col : int;
+ ori_source : int;
+ ori_line : int;
+ ori_col : int;
+ ori_name : int option
+}
+
+type mapping = map list
+
+type t = {
+ version : int;
+ file : string;
+ sourceroot : string option;
+ mutable sources : string list;
+ mutable sources_content : string option list;
+ mutable names : string list;
+ mutable mappings : mapping ;
+}
+
+let string_of_mapping mapping =
+ let a = Array.of_list mapping in
+ let len = Array.length a in
+ Array.fast_sort (fun t1 t2 ->
+ match compare t1.gen_line t2.gen_line with
+ | 0 -> compare t1.gen_col t2.gen_col
+ | n -> n) a;
+ let buf = Buffer.create 1024 in
+ let rec loop prev i =
+ if i >= len
+ then ()
+ else
+ let c = a.(i) in
+ let prev =
+ if prev.gen_line <> c.gen_line
+ then begin
+ assert (prev.gen_line < c.gen_line);
+ for j = prev.gen_line to c.gen_line - 1 do
+ Buffer.add_char buf ';';
+ done;
+ {prev with gen_col = 0; gen_line = c.gen_line}
+ end
+ else begin
+ if i > 0 then Buffer.add_char buf ',';
+ prev
+ end in
+ begin
+ let diff_name,prev_name = match c.ori_name, prev.ori_name with
+ | None,None -> None,None
+ | Some o,Some p -> Some (o - p), Some o
+ | Some o,None -> Some o, Some o
+ | None, Some p -> None, Some p in
+
+ let l = [c.gen_col - prev.gen_col;
+ c.ori_source - prev.ori_source;
+ c.ori_line - prev.ori_line;
+ c.ori_col - prev.ori_col ] in
+ let l = match diff_name with
+ | None -> l
+ | Some d -> l@[d] in
+
+ Vlq64.encode_l buf l;
+ loop {c with ori_name = prev_name} (succ i)
+ end
+ in
+ loop {gen_line=0;gen_col=0;ori_source=0;ori_line=0;ori_col=0;ori_name=None} 0;
+ Buffer.contents buf
+
+let expression t =
+ let open Javascript in
+ EObj [
+ PNS "version", ENum (float_of_int t.version);
+ PNS "file", EStr (t.file,`Bytes);
+ PNS "sourceRoot", EStr ((match t.sourceroot with None -> "" | Some s -> s),`Bytes);
+ PNS "sources", EArr (List.map (fun s -> Some (EStr (s,`Bytes))) t.sources);
+ PNS "sources_content", EArr (List.map (function
+ | None -> Some (EVar (S {name="null";var=None}))
+ | Some s -> Some (EStr (s,`Bytes))) t. sources_content);
+ PNS "names", EArr (List.map (fun s -> Some (EStr (s,`Bytes))) t.names);
+ PNS "mappings", EStr (string_of_mapping t.mappings,`Bytes)
+ ]
diff -Nru js-of-ocaml-1.4/compiler/source_map.mli js-of-ocaml-2.2/compiler/source_map.mli
--- js-of-ocaml-1.4/compiler/source_map.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/source_map.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,41 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+type map = {
+ gen_line : int;
+ gen_col : int;
+ ori_source : int;
+ ori_line : int;
+ ori_col : int;
+ ori_name : int option
+}
+
+type mapping = map list
+
+type t = {
+ version : int;
+ file : string;
+ sourceroot : string option;
+ mutable sources : string list;
+ mutable sources_content : string option list;
+ mutable names : string list;
+ mutable mappings : mapping ;
+}
+
+val expression : t -> Javascript.expression
diff -Nru js-of-ocaml-1.4/compiler/specialize_js.ml js-of-ocaml-2.2/compiler/specialize_js.ml
--- js-of-ocaml-1.4/compiler/specialize_js.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/specialize_js.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,182 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Code
+open Flow
+
+
+let specialize_instr info i =
+ match i with
+ | Let (x, Prim (Extern "caml_format_int", [y;z])) ->
+ begin match the_string_of info y with
+ | Some "%d" ->
+ begin match the_int info z with
+ | Some i -> Let(x,Constant(String (Int32.to_string i)))
+ | None -> Let (x, Prim (Extern "%caml_format_int_special", [z]))
+ end
+ | _ -> i
+ end
+ | Let (x, Prim (Extern "%caml_format_int_special", [z])) ->
+ begin match the_int info z with
+ | Some i -> Let(x,Constant(String (Int32.to_string i)))
+ | None -> i
+ end
+ | Let (x, Prim (Extern ("caml_js_var"|"caml_js_const"|"caml_js_expr" as prim), [y])) ->
+ begin match the_string_of info y with
+ Some s ->
+ Let (x, Prim (Extern prim, [Pc (String s)]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_call", [f; o; a])) ->
+ begin match the_def_of info a with
+ Some (Block (_, a)) ->
+ let a = Array.map (fun x -> Pv x) a in
+ Let (x, Prim (Extern "%caml_js_opt_call",
+ f :: o :: Array.to_list a))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_fun_call", [f; a])) ->
+ begin match the_def_of info a with
+ Some (Block (_, a)) ->
+ let a = Array.map (fun x -> Pv x) a in
+ Let (x, Prim (Extern "%caml_js_opt_fun_call",
+ f :: Array.to_list a))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_meth_call", [o; m; a])) ->
+ begin match the_string_of info m with
+ Some m ->
+ begin match the_def_of info a with
+ Some (Block (_, a)) ->
+ let a = Array.map (fun x -> Pv x) a in
+ Let (x, Prim (Extern "%caml_js_opt_meth_call",
+ o :: Pc (String m) :: Array.to_list a))
+ | _ ->
+ i
+ end
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_new", [c; a])) ->
+ begin match the_def_of info a with
+ Some (Block (_, a)) ->
+ let a = Array.map (fun x -> Pv x) a in
+ Let (x, Prim (Extern "%caml_js_opt_new",
+ c :: Array.to_list a))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_object", [a])) ->
+ begin try
+ let a =
+ match the_def_of info a with
+ Some (Block (_, a)) -> a
+ | _ -> raise Exit
+ in
+ let a =
+ Array.map
+ (fun x ->
+ match the_def_of info (Pv x) with
+ Some (Block (_, [|k; v|])) ->
+ let k =
+ match the_string_of info (Pv k) with
+ | Some s -> Pc (String s)
+ | _ -> raise Exit
+ in
+ [k; Pv v]
+ | _ ->
+ raise Exit)
+ a
+ in
+ Let (x, Prim (Extern "%caml_js_opt_object",
+ List.flatten (Array.to_list a)))
+ with Exit ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_get", [o; f])) ->
+ begin match the_string_of info f with
+ Some s ->
+ Let (x, Prim (Extern "caml_js_get", [o; Pc (String s)]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_set", [o; f; v])) ->
+ begin match the_string_of info f with
+ Some s ->
+ Let (x, Prim (Extern "caml_js_set", [o; Pc (String s); v]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_delete", [o; f])) ->
+ begin match the_string_of info f with
+ Some s ->
+ Let (x, Prim (Extern "caml_js_delete", [o; Pc (String s)]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "caml_js_from_string", [y])) ->
+ begin match the_string_of info y with
+ Some s when Util.is_ascii s ->
+ Let (x, Constant (IString s))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "%int_mul", [y; z])) ->
+ begin match the_int info y, the_int info z with
+ Some j, _ | _, Some j when Int32.abs j < 0x200000l ->
+ Let (x, Prim (Extern "%direct_int_mul", [y; z]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "%int_div", [y; z])) ->
+ begin match the_int info z with
+ Some j when j <> 0l ->
+ Let (x, Prim (Extern "%direct_int_div", [y; z]))
+ | _ ->
+ i
+ end
+ | Let (x, Prim (Extern "%int_mod", [y; z])) ->
+ begin match the_int info z with
+ Some j when j <> 0l ->
+ Let (x, Prim (Extern "%direct_int_mod", [y; z]))
+ | _ ->
+ i
+ end
+ | _ -> i
+
+let specialize_instrs info (pc, blocks, free_pc) =
+ let blocks =
+ AddrMap.map
+ (fun block ->
+ { block with
+ Code.body =
+ List.map (specialize_instr info) block.body;
+ })
+ blocks
+ in
+ (pc, blocks, free_pc)
+
+(****)
+
+let f info p = specialize_instrs info p
diff -Nru js-of-ocaml-1.4/compiler/specialize_js.mli js-of-ocaml-2.2/compiler/specialize_js.mli
--- js-of-ocaml-1.4/compiler/specialize_js.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/specialize_js.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,21 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val f : Flow.info -> Code.program -> Code.program
diff -Nru js-of-ocaml-1.4/compiler/specialize.ml js-of-ocaml-2.2/compiler/specialize.ml
--- js-of-ocaml-1.4/compiler/specialize.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/specialize.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,87 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Code
+open Flow
+
+let rec function_cardinality info x =
+ get_approx info
+ (fun x ->
+ match info.info_defs.(Var.idx x) with
+ | Expr (Closure (l, _)) ->
+ Some (List.length l)
+ | Expr (Apply (f, l, _)) ->
+ begin match function_cardinality info f with
+ Some n ->
+ let diff = n - List.length l in
+ if diff > 0 then Some diff else None
+ | None ->
+ None
+ end
+ | _ ->
+ None)
+ None
+ (fun u v -> match u, v with Some n, Some m when n = m -> u | _ -> None)
+ x
+
+let specialize_instr info (acc,free_pc,extra) i =
+ match i with
+ | Let (x, Apply (f, l, _)) when Option.Optim.optcall () -> begin
+ let n' = List.length l in
+ match function_cardinality info f with
+ | None -> i::acc,free_pc,extra
+ | Some n when n = n' -> Let (x, Apply (f, l, true))::acc,free_pc,extra
+ | Some n when n < n' ->
+ let v = Code.Var.fresh () in
+ let args,rest = Util.take n l in
+ (Let(v, Apply(f,args,true)))
+ ::(Let(x,Apply(v,rest,false)))
+ ::acc,free_pc,extra
+ | Some n when n > n' ->
+ let missing = Array.init (n - n') (fun _ -> Code.Var.fresh ()) in
+ let missing = Array.to_list missing in
+ let block =
+ let params' = Array.init (n - n') (fun _ -> Code.Var.fresh ()) in
+ let params' = Array.to_list params' in
+ let return' = Code.Var.fresh () in
+ { params=params';
+ body = [Let(return',Apply(f,l@params',true))];
+ branch = Return return';
+ handler = None;
+ } in
+ Let(x, Closure(missing,(free_pc,missing)))::acc,(free_pc + 1),(free_pc,block)::extra
+ | _ -> i::acc, free_pc,extra
+ end
+ | _ ->
+ i::acc,free_pc,extra
+
+let specialize_instrs info (pc, blocks, free_pc) =
+ let blocks,free_pc =
+ AddrMap.fold
+ (fun pc block (blocks,free_pc) ->
+ let body,free_pc,extra =
+ List.fold_right (fun i acc -> specialize_instr info acc i) block.body ([],free_pc,[]) in
+ let blocks = List.fold_left (fun blocks (pc,b) -> AddrMap.add pc b blocks) blocks extra in
+ (AddrMap.add pc { block with Code.body = body } blocks),free_pc)
+ blocks (AddrMap.empty,free_pc)
+ in
+ (pc, blocks, free_pc)
+
+let f info p = specialize_instrs info p
diff -Nru js-of-ocaml-1.4/compiler/specialize.mli js-of-ocaml-2.2/compiler/specialize.mli
--- js-of-ocaml-1.4/compiler/specialize.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/specialize.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,21 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val f : Flow.info -> Code.program -> Code.program
diff -Nru js-of-ocaml-1.4/compiler/tailcall.ml js-of-ocaml-2.2/compiler/tailcall.ml
--- js-of-ocaml-1.4/compiler/tailcall.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/tailcall.ml 2014-05-15 08:37:39.000000000 +0000
@@ -18,7 +18,7 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
-let times = Util.debug "times"
+let times = Option.Debug.find "times"
open Code
@@ -40,23 +40,11 @@
| i :: rem ->
tail_call x f rem
-let rec return ?(subst=VarMap.empty) block blocks =
- match block.branch with
- | Return x -> Some (Subst.from_map subst x)
- | Branch (pc,l) ->
- let block = AddrMap.find pc blocks in
- if block.body = []
- then
- let subst = Subst.build_mapping block.params l in
- return ~subst block blocks
- else None
- | _ -> None
-
let rewrite_block (f, f_params, f_pc, args) pc blocks =
(*Format.eprintf "%d@." pc;*)
let block = AddrMap.find pc blocks in
- match return block blocks with
- | Some x ->
+ match block.branch with
+ | Return x ->
begin match tail_call x f block.body with
Some f_args when List.length f_params = List.length f_args ->
let m = Subst.build_mapping f_params f_args in
@@ -65,8 +53,7 @@
handler = block.handler;
body = remove_last block.body;
branch =
- Branch
- (f_pc, List.map (fun x -> VarMap.find x m) args) }
+ Branch (f_pc, List.map (fun x -> VarMap.find x m) args) }
blocks
| _ ->
blocks
diff -Nru js-of-ocaml-1.4/compiler/util.ml js-of-ocaml-2.2/compiler/util.ml
--- js-of-ocaml-1.4/compiler/util.ml 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/util.ml 2014-05-15 08:37:39.000000000 +0000
@@ -23,6 +23,7 @@
module IntMap = Map.Make (Int)
module StringSet = Set.Make (String)
+module StringMap = Map.Make (String)
let opt_map f x = match x with None -> None | Some v -> Some (f v)
let opt_iter f x = match x with None -> () | Some v -> f v
@@ -32,13 +33,32 @@
(****)
-let rec find_in_paths paths name =
+let findlib_init = Lazy.lazy_from_fun Findlib.init
+
+let find_pkg_dir pkg =
+ let () = Lazy.force findlib_init in
+ try Findlib.package_directory pkg with _ -> raise Not_found
+
+let path_require_findlib path =
+ if path <> "" && path.[0] = '+'
+ then Some (String.sub path 1 (String.length path - 1))
+ else None
+
+let rec find_in_paths ?(pkg="stdlib") paths name =
match paths with
- [] ->
+ | [] ->
raise Not_found
- | path :: rem ->
- let file = Filename.concat path name in
- if Sys.file_exists file then file else find_in_paths rem name
+ | path :: rem ->
+ try
+ let file = match path_require_findlib path with
+ | Some path ->
+ let () = Lazy.force findlib_init in
+ Filename.concat (Filename.concat (find_pkg_dir pkg) path) name
+ | None -> Filename.concat path name in
+
+ if Sys.file_exists file then file else
+ find_in_paths rem name
+ with Not_found -> find_in_paths rem name
let read_file f =
let ch = open_in_bin f in
@@ -52,38 +72,29 @@
close_in ch;
Buffer.contents b
-(****)
-
-let debugs = ref []
-
-let debug s =
- let state =
- try
- List.assoc s !debugs
- with Not_found ->
- let state = ref false in
- debugs := (s, state) :: !debugs;
- state
- in
- fun () -> !state
-
-let set_debug s =
- try List.assoc s !debugs := true with Not_found -> ()
-
-(****)
-
-let disabled_lst = ref []
-
-let disabled s =
- let state = ref false in
- disabled_lst := (s, state) :: !disabled_lst;
- fun () -> !state
-
-let set_disabled s =
- try List.assoc s !disabled_lst := true with Not_found ->
- Format.eprintf "%s: no disable option named '%s'@." Sys.argv.(0) s; exit 1
-
-(****)
+let filter_map f l =
+ let l = List.fold_left (fun acc x -> match f x with
+ | Some x -> x::acc
+ | None -> acc) [] l
+ in List.rev l
+
+let array_fold_right_i f a x =
+ let r = ref x in
+ for i = Array.length a - 1 downto 0 do
+ r := f i (Array.unsafe_get a i) !r
+ done;
+ !r
+
+let rec take' acc n l =
+ if n = 0
+ then acc,l
+ else match l with
+ | [] -> acc,[]
+ | x::xs -> take' (x::acc) (pred n) xs
+
+let take n l =
+ let x,xs = take' [] n l in
+ List.rev x, xs
module Timer = struct
type t = float
@@ -93,3 +104,195 @@
let get t = !timer () -. t
let print f t = Format.fprintf f "%.2f" (get t)
end
+
+
+let is_ascii s =
+ let res = ref true in
+ for i = 0 to String.length s - 1 do
+ if s.[i] > '\127' then res := false
+ done;
+ !res
+
+let has_backslash s =
+ let res = ref false in
+ for i = 0 to String.length s - 1 do
+ if s.[i] = '\\' then res := true
+ done;
+ !res
+
+let fail = ref true
+
+let failwith_ fmt =
+ Printf.ksprintf (fun s ->
+ if !fail
+ then failwith s
+ else Format.eprintf "%s@." s) fmt
+
+let raise_ exn =
+ if !fail
+ then raise exn
+ else begin
+ Format.eprintf "%s@." (Printexc.to_string exn)
+ end
+
+let split_char sep p =
+ let len = String.length p in
+ let rec split beg cur =
+ if cur >= len then
+ if cur - beg > 0
+ then [String.sub p beg (cur - beg)]
+ else []
+ else if p.[cur] = sep then
+ String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+ else
+ split beg (cur + 1) in
+ split 0 0
+
+(* copied from https://github.com/ocaml/ocaml/pull/10 *)
+let split sep s =
+ let sep_len = String.length sep in
+ if sep_len = 1
+ then split_char sep.[0] s
+ else
+ let sep_max = sep_len - 1 in
+ if sep_max < 0 then invalid_arg "String.split: empty separator" else
+ let s_max = String.length s - 1 in
+ if s_max < 0 then [""] else
+ let acc = ref [] in
+ let sub_start = ref 0 in
+ let k = ref 0 in
+ let i = ref 0 in
+ (* We build the substrings by running from the start of [s] to the
+ end with [i] trying to match the first character of [sep] in
+ [s]. If this matches, we verify that the whole [sep] is matched
+ using [k]. If this matches we extract a substring from the start
+ of the current substring [sub_start] to [!i - 1] (the position
+ before the [sep] we found). We then continue to try to match
+ with [i] by starting after the [sep] we just found, this is also
+ becomes the start position of the next substring. If [i] is such
+ that no separator can be found we exit the loop and make a
+ substring from [sub_start] until the end of the string. *)
+ while (!i + sep_max <= s_max) do
+ if String.unsafe_get s !i <> String.unsafe_get sep 0 then incr i else
+ begin
+ (* Check remaining [sep] chars match, access to unsafe s (!i + !k) is
+ guaranteed by loop invariant. *)
+ k := 1;
+ while (!k <= sep_max && String.unsafe_get s (!i + !k) = String.unsafe_get sep !k)
+ do incr k done;
+ if !k <= sep_max then (* no match *) incr i else begin
+ let new_sub_start = !i + sep_max + 1 in
+ let sub_end = !i - 1 in
+ let sub_len = sub_end - !sub_start + 1 in
+ acc := String.sub s !sub_start sub_len :: !acc;
+ sub_start := new_sub_start;
+ i := new_sub_start;
+ end
+ end
+ done;
+ List.rev (String.sub s !sub_start (s_max - !sub_start + 1) :: !acc)
+
+exception Found of int
+let find sep s =
+ let sep_max = String.length sep - 1 in
+ let s_max = String.length s - 1 in
+ if sep_max < 0 then invalid_arg "find: empty string";
+ let k = ref 0 in
+ let i = ref 0 in
+ try
+ while (!i + sep_max <= s_max) do
+ if String.unsafe_get s !i <> String.unsafe_get sep 0
+ then incr i
+ else
+ begin
+ (* Check remaining [sep] chars match, access to unsafe s (!i + !k) is
+ guaranteed by loop invariant. *)
+ k := 1;
+ while (!k <= sep_max && String.unsafe_get s (!i + !k) = String.unsafe_get sep !k)
+ do incr k done;
+ if !k <= sep_max then (* no match *) incr i else raise (Found !i)
+ end
+ done;
+ raise Not_found
+ with Found i -> i
+
+module Version = struct
+ type t = int list
+ let split v =
+ match split_char '+' v with
+ | [] -> assert false
+ | x::_ -> List.map int_of_string (split_char '.' x)
+
+ let current = split Sys.ocaml_version
+
+ let compint (a : int) b = compare a b
+
+ let rec compare v v' = match v,v' with
+ | [x],[y] -> 0
+ | [],[] -> 0
+ | [],y::_ -> compint 0 y
+ | x::_,[] -> compint x 0
+ | x::xs,y::ys ->
+ match compint x y with
+ | 0 -> compare xs ys
+ | n -> n
+
+ let v =
+ if compare current [4;2] < 0 then
+ `V3
+ else
+ `V4_02
+
+end
+
+module MagicNumber = struct
+ type t = string * int
+
+ exception Bad_magic_number of string
+ exception Bad_magic_version of t
+
+ let size = 12
+
+ let kind_of_string = function
+ | "Caml1999X" -> "exe"
+ | "Caml1999I" -> "cmi"
+ | "Caml1999O" -> "cmo"
+ | "Caml1999A" -> "cma"
+ | "Caml1999Y" -> "cmx"
+ | "Caml1999Z" -> "cmxa"
+ | "Caml2007D" -> "cmxs"
+ | "Caml2012T" -> "cmt"
+ | "Caml1999M" -> "impl"
+ | "Caml1999N" -> "intf"
+ | s -> raise Not_found
+
+ let of_string s =
+ try
+ if String.length s <> size
+ then raise Not_found;
+ let kind = String.sub s 0 9 in
+ let v = String.sub s 9 3 in
+ kind, int_of_string v
+ with _ -> raise (Bad_magic_number s)
+
+ let to_string (k,v) = Printf.sprintf "%s%03d" k v
+
+ let compare (p1,n1) (p2,n2) =
+ if p1 <> p2 then raise Not_found;
+ compare n1 n2
+
+ let current =
+ let v = match Version.v with
+ | `V3 -> 8
+ | `V4_02 -> 11 in
+ ("Caml1999X",v)
+
+ let assert_current h': unit =
+ let (t',v') as h = of_string h' in
+ let t,v = current in
+ if t <> t'
+ then raise_ (Bad_magic_number h')
+ else if v <> v'
+ then raise_ (Bad_magic_version h)
+ else ()
+end
diff -Nru js-of-ocaml-1.4/compiler/util.mli js-of-ocaml-2.2/compiler/util.mli
--- js-of-ocaml-1.4/compiler/util.mli 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/compiler/util.mli 2014-05-15 08:37:39.000000000 +0000
@@ -22,19 +22,23 @@
module IntMap : Map.S with type key = int
module StringSet : Set.S with type elt = string
+module StringMap : Map.S with type key = string
val opt_filter : ('a -> bool) -> 'a option -> 'a option
val opt_map : ('a -> 'b) -> 'a option -> 'b option
val opt_iter : ('a -> unit) -> 'a option -> unit
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+val array_fold_right_i : (int -> 'a -> 'b -> 'b) -> 'a array -> 'b -> 'b
-val find_in_paths : string list -> string -> string
+val path_require_findlib : string -> string option
+val find_pkg_dir : string -> string
+val find_in_paths : ?pkg:string -> string list -> string -> string
val read_file : string -> string
-val debug : string -> unit -> bool
-val set_debug : string -> unit
+val take : int -> 'a list -> 'a list * 'a list
-val disabled : string -> unit -> bool
-val set_disabled : string -> unit
+val is_ascii : string -> bool
+val has_backslash : string -> bool
module Timer : sig
type t
@@ -43,3 +47,34 @@
val get : t -> float
val print : Format.formatter -> t -> unit
end
+
+val fail : bool ref
+val failwith_ : ('a,unit,string,unit) format4 -> 'a
+val raise_ : exn -> unit
+
+val split_char : char -> string -> string list
+val split : string -> string -> string list
+val find : string -> string -> int
+
+
+module Version : sig
+ type t = int list
+ val current : t
+ val compare : t -> t -> int
+ val split : string -> t
+ val v : [ `V3 (* OCaml 3.12 to 4.01 *)
+ | `V4_02 ] (* OCaml 4.02 *)
+end
+
+module MagicNumber : sig
+ type t = private string * int
+ exception Bad_magic_number of string
+ exception Bad_magic_version of t
+
+ val size : int
+ val compare : t -> t -> int
+ val of_string : string -> t
+ val to_string : t -> string
+ val current : t
+ val assert_current : string -> unit
+end
diff -Nru js-of-ocaml-1.4/compiler/varPrinter.ml js-of-ocaml-2.2/compiler/varPrinter.ml
--- js-of-ocaml-1.4/compiler/varPrinter.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/varPrinter.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,141 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+open Util
+
+type t = {
+ names : (int,string) Hashtbl.t;
+ known : (int,string) Hashtbl.t;
+ cache : (int*int,string) Hashtbl.t;
+ mutable last : int;
+ mutable pretty : bool;
+}
+
+let c1 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_$"
+let c2 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$"
+
+let name_raw t v nm = Hashtbl.add t.names v nm
+let propagate_name t v v' =
+ try name_raw t v' (Hashtbl.find t.names v) with Not_found -> ()
+
+let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
+let is_num c = (c >= '0' && c <= '9')
+
+let name t v nm_orig =
+ let len = String.length nm_orig in
+ if len > 0 then begin
+ let buf = Buffer.create (String.length nm_orig) in
+ let idx = ref 0 in
+ while (!idx < len && not (is_alpha nm_orig.[!idx])) do incr idx done;
+ let pending = ref false in
+ if(!idx >= len) then begin
+ pending := true;
+ idx := 0
+ end;
+ for i = !idx to len - 1 do
+ if is_alpha nm_orig.[i] || is_num nm_orig.[i]
+ then begin
+ if !pending
+ then Buffer.add_char buf '_';
+ Buffer.add_char buf nm_orig.[i];
+ pending:=false
+ end
+ else pending := true
+ done;
+ let str = Buffer.contents buf in
+ if String.length str > 0
+ then name_raw t v str
+ end
+
+let rec format_ident x =
+ assert (x >= 0);
+ let char c x = String.make 1 (c.[x]) in
+ if x < 54 then
+ char c1 x
+ else
+ format_ident ((x - 54) / 64) ^ char c2 ((x - 54) mod 64)
+
+let format_var t i x =
+ let s = format_ident x in
+ if t.pretty
+ then Format.sprintf "_%s_" s
+ else s
+
+let reserved = ref StringSet.empty
+
+let add_reserved s = reserved := List.fold_left (fun acc x ->
+ StringSet.add x acc) !reserved s
+
+
+let _ = reserved := StringSet.union !reserved Reserved.keyword(* ; *)
+(* add_reserved Reserved.provided *)
+
+let get_reserved () = !reserved
+
+let is_reserved s = StringSet.mem s !reserved
+
+let rec to_string t ?origin i =
+ let origin = match origin with
+ | Some i when t.pretty -> i
+ | _ -> i in
+ try
+ Hashtbl.find t.cache (i,origin)
+ with Not_found ->
+ let name =
+ try
+ Hashtbl.find t.known i
+ with Not_found ->
+ t.last <- t.last + 1;
+ let j = t.last in
+ let s = format_var t i j in
+ if is_reserved s then
+ to_string t i
+ else begin
+ Hashtbl.add t.known i s;
+ s
+ end in
+ let name =
+ if t.pretty
+ then
+ try
+ let nm = Hashtbl.find t.names origin in
+ nm ^ name
+ with Not_found -> name
+ else name
+ in
+ Hashtbl.add t.cache (i,origin) name;
+ name
+
+
+let set_pretty t b = t.pretty <- b
+
+
+let reset t =
+ Hashtbl.clear t.names; Hashtbl.clear t.known; Hashtbl.clear t.cache;
+ t.last <- -1
+
+let create ?(pretty=false) () =
+ let t = {
+ names = Hashtbl.create 107;
+ known = Hashtbl.create 1001;
+ cache = Hashtbl.create 1001;
+ last = -1;
+ pretty;
+ } in
+ t
diff -Nru js-of-ocaml-1.4/compiler/varPrinter.mli js-of-ocaml-2.2/compiler/varPrinter.mli
--- js-of-ocaml-1.4/compiler/varPrinter.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/varPrinter.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,29 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+type t
+
+val add_reserved : string list -> unit
+val get_reserved : unit -> Util.StringSet.t
+val create : ?pretty:bool -> unit -> t
+val reset : t -> unit
+val to_string : t -> ?origin:int -> int -> string
+val name : t -> int -> string -> unit
+val propagate_name : t -> int -> int -> unit
+val set_pretty : t -> bool -> unit
diff -Nru js-of-ocaml-1.4/compiler/vlq64.ml js-of-ocaml-2.2/compiler/vlq64.ml
--- js-of-ocaml-1.4/compiler/vlq64.ml 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/vlq64.ml 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,100 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
+let code_rev =
+ let a = Array.make 127 (-1) in
+ for i = 0 to String.length code - 1 do
+ a.(Char.code code.[i]) <- i;
+ done;
+ a
+
+let vlq_base_shift = 5
+(* binary: 100000 *)
+let vlq_base = 1 lsl vlq_base_shift
+(* binary: 011111 *)
+let vlq_base_mask = vlq_base - 1
+(* binary: 100000 *)
+let vlq_continuation_bit = vlq_base
+
+let toVLQSigned v =
+ if v < 0
+ then ((-v) lsl 1) + 1
+ else (v lsl 1);;
+
+(* assert (toVLQSigned 1 = 2); *)
+(* assert (toVLQSigned 2 = 4); *)
+(* assert (toVLQSigned (-1) = 3); *)
+(* assert (toVLQSigned (-2) = 5);; *)
+
+let fromVLQSigned v =
+ let is_neg = (v land 1) = 1 in
+ let shift = v lsr 1 in
+ if is_neg then - shift else shift
+
+(* assert (fromVLQSigned 2 = 1); *)
+(* assert (fromVLQSigned 4 = 2); *)
+(* assert (fromVLQSigned 3 = -1); *)
+(* assert (fromVLQSigned 5 = -2);; *)
+
+let add_char buf x = Buffer.add_char buf code.[x]
+
+let rec encode' buf x =
+ let digit = x land vlq_base_mask in
+ let rest = x lsr vlq_base_shift in
+ if rest = 0
+ then add_char buf digit
+ else begin
+ add_char buf (digit lor vlq_continuation_bit);
+ encode' buf rest;
+ end
+
+let encode b x =
+ let vql = toVLQSigned x in
+ encode' b vql
+
+let encode_l b l = List.iter (encode b) l
+
+let rec decode' acc s start pos =
+ let digit = code_rev.(Char.code s.[pos]) in
+ let cont = digit land vlq_continuation_bit = vlq_continuation_bit in
+ let digit = digit land vlq_base_mask in
+ let acc = acc + (digit lsl ((pos - start) * vlq_base_shift)) in
+ if cont
+ then decode' acc s start (succ pos)
+ else acc,succ pos
+
+let decode s p =
+ let d,i = decode' 0 s p p in
+ fromVLQSigned d,i
+
+let decode_pos s =
+ let sl = String.length s in
+ let rec aux pos acc =
+ if List.length acc > 10 then assert false;
+ let d,i = decode s pos in
+ if i = sl
+ then List.rev (d::acc)
+ else aux i (d::acc)
+ in aux 0 []
+
+
+(* let _ = assert ( *)
+(* let l = [0;0;16;1] in *)
+(* decode_pos (encode_pos l) = l); *)
diff -Nru js-of-ocaml-1.4/compiler/vlq64.mli js-of-ocaml-2.2/compiler/vlq64.mli
--- js-of-ocaml-1.4/compiler/vlq64.mli 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/compiler/vlq64.mli 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2013 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val encode_l : Buffer.t -> int list -> unit
diff -Nru js-of-ocaml-1.4/debian/changelog js-of-ocaml-2.2/debian/changelog
--- js-of-ocaml-1.4/debian/changelog 2014-02-03 18:19:54.000000000 +0000
+++ js-of-ocaml-2.2/debian/changelog 2014-06-18 12:19:53.000000000 +0000
@@ -1,8 +1,16 @@
-js-of-ocaml (1.4-1build1) trusty; urgency=medium
+js-of-ocaml (2.2-2) unstable; urgency=medium
- * Rebuild for new OCaml ABIs.
+ * Fix FTBFS on bytecode architectures
- -- Colin Watson Mon, 03 Feb 2014 18:19:54 +0000
+ -- Stéphane Glondu Wed, 18 Jun 2014 12:59:58 +0200
+
+js-of-ocaml (2.2-1) unstable; urgency=medium
+
+ * New upstream release (Closes: #751693)
+ * debian/patches:
+ + Fix generation of compiler.cm*
+
+ -- Stéphane Glondu Tue, 17 Jun 2014 11:45:02 +0200
js-of-ocaml (1.4-1) unstable; urgency=medium
diff -Nru js-of-ocaml-1.4/debian/control js-of-ocaml-2.2/debian/control
--- js-of-ocaml-1.4/debian/control 2013-12-27 20:07:34.000000000 +0000
+++ js-of-ocaml-2.2/debian/control 2014-06-15 10:25:04.000000000 +0000
@@ -8,8 +8,9 @@
dh-ocaml (>= 0.9~),
ocaml-findlib (>= 1.4),
liblwt-ocaml-dev (>= 2.4),
- libderiving-ocsigen-ocaml-dev (>= 0.3),
+ libderiving-ocsigen-ocaml-dev (>= 0.6),
camlp4,
+ menhir,
ocaml-nox (>= 4.01)
Standards-Version: 3.9.5
Homepage: http://ocsigen.org/js_of_ocaml
diff -Nru js-of-ocaml-1.4/debian/libjs-of-ocaml-dev.install.in js-of-ocaml-2.2/debian/libjs-of-ocaml-dev.install.in
--- js-of-ocaml-1.4/debian/libjs-of-ocaml-dev.install.in 2013-12-27 20:03:37.000000000 +0000
+++ js-of-ocaml-2.2/debian/libjs-of-ocaml-dev.install.in 2014-06-18 12:19:53.000000000 +0000
@@ -4,8 +4,11 @@
@OCamlStdlibDir@/js_of_ocaml/*.mli
@OCamlStdlibDir@/js_of_ocaml/js_of_ocaml.cma
@OCamlStdlibDir@/js_of_ocaml/pa_*.cmo
+@OCamlStdlibDir@/js_of_ocaml/ocamlbuild_js_of_ocaml.cma
OPT: @OCamlStdlibDir@/js_of_ocaml/*.cmx
OPT: @OCamlStdlibDir@/js_of_ocaml/*.cmxa
OPT: lib/syntax/pa_js.o @OCamlStdlibDir@/js_of_ocaml
OPT: lib/syntax/pa_deriving_Json.o @OCamlStdlibDir@/js_of_ocaml
DYN: @OCamlStdlibDir@/js_of_ocaml/pa_*.cmxs
+DYN: @OCamlStdlibDir@/js_of_ocaml/ocamlbuild_js_of_ocaml.cmxs
+OPT: compiler/compiler.a @OCamlStdlibDir@/js_of_ocaml
diff -Nru js-of-ocaml-1.4/debian/libjs-of-ocaml.install.in js-of-ocaml-2.2/debian/libjs-of-ocaml.install.in
--- js-of-ocaml-1.4/debian/libjs-of-ocaml.install.in 2013-12-27 20:03:37.000000000 +0000
+++ js-of-ocaml-2.2/debian/libjs-of-ocaml.install.in 2014-06-17 10:44:16.000000000 +0000
@@ -1,4 +1,6 @@
@OCamlDllDir@/*.so
@OCamlStdlibDir@/js_of_ocaml/META
@OCamlStdlibDir@/js_of_ocaml/deriving_json.cma
+@OCamlStdlibDir@/js_of_ocaml/compiler.cma
DYN: @OCamlStdlibDir@/js_of_ocaml/deriving_json.cmxs
+DYN: @OCamlStdlibDir@/js_of_ocaml/compiler.cmxs
diff -Nru js-of-ocaml-1.4/debian/patches/0001-Fix-generation-of-compiler.cm.patch js-of-ocaml-2.2/debian/patches/0001-Fix-generation-of-compiler.cm.patch
--- js-of-ocaml-1.4/debian/patches/0001-Fix-generation-of-compiler.cm.patch 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/debian/patches/0001-Fix-generation-of-compiler.cm.patch 2014-06-17 10:44:16.000000000 +0000
@@ -0,0 +1,40 @@
+From: Stephane Glondu
+Date: Tue, 17 Jun 2014 11:41:17 +0200
+Subject: Fix generation of compiler.cm*
+
+---
+ compiler/Makefile | 12 +++++++++---
+ 1 file changed, 9 insertions(+), 3 deletions(-)
+
+diff --git a/compiler/Makefile b/compiler/Makefile
+index ba1675d..4d1b306 100644
+--- a/compiler/Makefile
++++ b/compiler/Makefile
+@@ -40,17 +40,23 @@ minify.opt: $(OBJS:cmx=cmx) minify.cmx
+ ocamlfind ocamlopt -package $(PACKAGES) -linkpkg -g -o $@ $^
+
+
+-compiler.cma: $(OBJS:cmx=cmo)
++compiler.cmo: $(OBJS:cmx=cmo)
+ ocamlfind ocamlc -pack -o $@ $^
+
++compiler.cma: compiler.cmo
++ ocamlfind ocamlc -a -o $@ $^
++
+ local/compiler.cma: compiler.cma
+ mkdir -p local
+ cp compiler.cma compiler.cmi local/
+
+-compiler.cmxa: $(OBJS)
++compiler.cmx: $(OBJS)
+ ocamlfind ocamlopt -pack -g -o $@ $^
+
+-compiler.cmxs: $(OBJS)
++compiler.cmxa: compiler.cmx
++ ocamlfind ocamlopt -a -o $@ $^
++
++compiler.cmxs: compiler.cmxa
+ ocamlfind ocamlopt -shared -g -o $@ $^
+
+ VERSION := $(shell head -n 1 ../VERSION)
+--
diff -Nru js-of-ocaml-1.4/debian/patches/0002-Bytecode-only-support.patch js-of-ocaml-2.2/debian/patches/0002-Bytecode-only-support.patch
--- js-of-ocaml-1.4/debian/patches/0002-Bytecode-only-support.patch 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/debian/patches/0002-Bytecode-only-support.patch 2014-06-18 12:19:53.000000000 +0000
@@ -0,0 +1,22 @@
+From: Stephane Glondu
+Date: Wed, 18 Jun 2014 11:14:55 +0200
+Subject: Bytecode-only support
+
+---
+ compiler/Makefile | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/compiler/Makefile b/compiler/Makefile
+index 4d1b306..539b902 100644
+--- a/compiler/Makefile
++++ b/compiler/Makefile
+@@ -3,7 +3,7 @@ include ../Makefile.conf
+
+ all: $(COMPILER) $(MINIFIER)
+
+-lib: compiler.cma compiler.cmxa compiler.cmxs
++lib: compiler.cma $(if $(wildcard /usr/bin/ocamlopt),compiler.cmxa) $(if $(wildcard /usr/lib/ocaml/dynlink.cmxa),compiler.cmxs)
+
+ PACKAGES=findlib
+
+--
diff -Nru js-of-ocaml-1.4/debian/patches/series js-of-ocaml-2.2/debian/patches/series
--- js-of-ocaml-1.4/debian/patches/series 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/debian/patches/series 2014-06-18 12:19:53.000000000 +0000
@@ -0,0 +1,2 @@
+0001-Fix-generation-of-compiler.cm.patch
+0002-Bytecode-only-support.patch
diff -Nru js-of-ocaml-1.4/debian/source.lintian-overrides js-of-ocaml-2.2/debian/source.lintian-overrides
--- js-of-ocaml-1.4/debian/source.lintian-overrides 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/debian/source.lintian-overrides 2014-06-17 10:44:16.000000000 +0000
@@ -0,0 +1 @@
+js-of-ocaml source: source-is-missing doc/manual-aux/toplevel/toplevel.js
diff -Nru js-of-ocaml-1.4/debian/watch js-of-ocaml-2.2/debian/watch
--- js-of-ocaml-1.4/debian/watch 2013-12-27 18:36:17.000000000 +0000
+++ js-of-ocaml-2.2/debian/watch 2014-06-12 13:33:15.000000000 +0000
@@ -1,5 +1,2 @@
version=3
-http://ocsigen.org/download/js_of_ocaml-(.*)\.tar\.gz
-# Upstream darcs repository:
-# http://ocsigen.org/darcs/js_of_ocaml/
-# http://ocsigen.org/darcsweb/?r=js_of_ocaml;a=summary
+http://ocsigen.org/js_of_ocaml/install .*/archive/(.*)\.tar\.gz
diff -Nru js-of-ocaml-1.4/doc/api-index js-of-ocaml-2.2/doc/api-index
--- js-of-ocaml-1.4/doc/api-index 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/api-index 2014-05-15 08:37:39.000000000 +0000
@@ -14,14 +14,33 @@
XmlHttpRequest
Event_arrows
Json
-Deriving_Json
File
Form
+Sys_js
Typed_array
WebGL
WebSockets
}
+{1 Deriving - API Reference}
+
+{!modules:
+Deriving_Json
+Pa_deriving_Json
+}
+
+{1 Graphics - API Reference}
+
+{!modules:
+Graphics_js
+}
+
+{1 The ocamlbuild plugin - API Reference}
+
+{!modules:
+Ocamlbuild_js_of_ocaml
+}
+
{1 Indexes}
{!indexlist}
diff -Nru js-of-ocaml-1.4/doc/api.odocl js-of-ocaml-2.2/doc/api.odocl
--- js-of-ocaml-1.4/doc/api.odocl 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/doc/api.odocl 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,26 @@
+lib/Js
+lib/Dom
+lib/Typed_array
+lib/Dom_html
+lib/File
+lib/Dom_events
+lib/Firebug
+lib/Lwt_js
+lib/Regexp
+lib/CSS
+lib/Url
+lib/Form
+lib/XmlHttpRequest
+lib/Event_arrows
+lib/Lwt_js_events
+lib/Json
+lib/WebGL
+lib/WebSockets
+lib/Keycode
+lib/Sys_js
+lib/graphics/Graphics_js
+
+lib/deriving_json/Deriving_Json
+lib/syntax/Pa_deriving_Json
+
+ocamlbuild/Ocamlbuild_js_of_ocaml
diff -Nru js-of-ocaml-1.4/doc/Makefile js-of-ocaml-2.2/doc/Makefile
--- js-of-ocaml-1.4/doc/Makefile 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/Makefile 2014-05-15 08:37:39.000000000 +0000
@@ -5,21 +5,48 @@
MLIS := ${addprefix ../, ${DOC}}
+ifneq "${WITH_GRAPHICS}" ""
+OTHER=-package graphics -I ../lib/graphics
+endif
+
.PHONY: doc docwiki
doc: api-html/index.html
api-html/index.html: ${MLIS} api-index
mkdir -p api-html
- ocamlfind ocamldoc -package lwt -intro api-index -html \
- -d api-html -I ../lib -I ../lib/deriving_json ${MLIS}
+ ocamlfind ocamldoc -package lwt -package ocamlbuild,deriving.syntax.common ${OTHER} -intro api-index -html \
+ -d api-html -I ../lib -I ../lib/deriving_json -I ../lib/syntax ${MLIS}
docwiki: api-wiki/index.wiki
api-wiki/index.wiki: ${MLIS} api-index
mkdir -p api-wiki
- ocamlfind ocamldoc -package lwt -intro api-index \
- -d api-wiki -I ../lib -I ../lib/deriving_json \
+ ocamlfind ocamldoc -package lwt -package ocamlbuild,deriving.syntax.common ${OTHER} -intro api-index \
+ -d api-wiki -I ../lib -I ../lib/deriving_json -I ../lib/syntax \
-i $(shell ocamlfind query wikidoc) -g odoc_wiki.cma \
${MLIS}
+EX_TOPLEVEL:=index.html toplevel.js toplevel-fs.js
+EX_BOULDER:=index.html boulderdash.js sprites
+EX_WEBGL:=index.html webgldemo.js
+EX_GRAPH:=index.html jsviewer.js
+EX_PLANET:=index.html texture.jpg planet.js
+EX_WIKI:=index.html wiki.js
+EX_WYSIWYG:=index.html wiki.js
+EX_HYPER:=index.html hypertree.js icons
+EX_MINE:=index.html minesweeper.js sprites
+EX_CUBE:=index.html cubes.js
+
+cp-examples:
+ cp -R ${addprefix ../toplevel/, ${EX_TOPLEVEL}} manual-aux/toplevel/
+ cp -R ${addprefix ../examples/boulderdash/, ${EX_BOULDER}} manual-aux/boulderdash/
+ cp -R ${addprefix ../examples/webgl/, ${EX_WEBGL}} manual-aux/webgl/
+ cp -R ${addprefix ../examples/graph_viewer/, ${EX_GRAPH}} manual-aux/graph_viewer/
+ cp -R ${addprefix ../examples/planet/, ${EX_PLANET}} manual-aux/planet/
+ cp -R ${addprefix ../examples/wiki/, ${EX_WIKI}} manual-aux/wiki/
+ cp -R ${addprefix ../examples/wysiwyg/, ${EX_WYSIWYG}} manual-aux/wysiwyg/
+ cp -R ${addprefix ../examples/minesweeper/, ${EX_MINE}} manual-aux/minesweeper/
+ cp -R ${addprefix ../examples/cubes/, ${EX_CUBE}} manual-aux/cubes/
+ cp -R ${addprefix ../examples/hyperbolic/, ${EX_HYPER}} manual-aux/hyperbolic/
+
clean:
-rm -rf api-html/* api-wiki/*
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/boulderdash.js js-of-ocaml-2.2/doc/manual-aux/boulderdash/boulderdash.js
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/boulderdash.js 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/boulderdash.js 2014-05-15 08:37:39.000000000 +0000
@@ -1,735 +1,1391 @@
-// This program was compiled from OCaml by js_of_ocaml 1.0
-function caml_raise_with_arg (tag, arg) { throw [0, tag, arg]; }
-function caml_raise_with_string (tag, msg) {
- caml_raise_with_arg (tag, new MlWrappedString (msg));
-}
-function caml_invalid_argument (msg) {
- caml_raise_with_string(caml_global_data[4], msg);
-}
-function caml_array_bound_error () {
- caml_invalid_argument("index out of bounds");
-}
-function caml_str_repeat(n, s) {
- if (!n) { return ""; }
- if (n & 1) { return caml_str_repeat(n - 1, s) + s; }
- var r = caml_str_repeat(n >> 1, s);
- return r + r;
-}
-function MlString(param) {
- if (param != null) {
- this.bytes = this.fullBytes = param;
- this.last = this.len = param.length;
- }
-}
-MlString.prototype = {
- string:null,
- bytes:null,
- fullBytes:null,
- array:null,
- len:null,
- last:0,
- toJsString:function() {
- return this.string = decodeURIComponent (escape(this.getFullBytes()));
- },
- toBytes:function() {
- if (this.string != null)
- var b = unescape (encodeURIComponent (this.string));
- else {
- var b = "", a = this.array, l = a.length;
- for (var i = 0; i < l; i ++) b += String.fromCharCode (a[i]);
- }
- this.bytes = this.fullBytes = b;
- this.last = this.len = b.length;
- return b;
- },
- getBytes:function() {
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- return b;
- },
- getFullBytes:function() {
- var b = this.fullBytes;
- if (b !== null) return b;
- b = this.bytes;
- if (b == null) b = this.toBytes ();
- if (this.last < this.len) {
- this.bytes = (b += caml_str_repeat(this.len - this.last, '\0'));
- this.last = this.len;
- }
- this.fullBytes = b;
- return b;
- },
- toArray:function() {
- var b = this.bytes;
- if (b == null) b = this.toBytes ();
- var a = [], l = this.last;
- for (var i = 0; i < l; i++) a[i] = b.charCodeAt(i);
- for (l = this.len; i < l; i++) a[i] = 0;
- this.string = this.bytes = this.fullBytes = null;
- this.last = this.len;
- this.array = a;
- return a;
- },
- getArray:function() {
- var a = this.array;
- if (!a) a = this.toArray();
- return a;
- },
- getLen:function() {
- var len = this.len;
- if (len !== null) return len;
- this.toBytes();
- return this.len;
- },
- toString:function() { var s = this.string; return s?s:this.toJsString(); },
- valueOf:function() { var s = this.string; return s?s:this.toJsString(); },
- blitToArray:function(i1, a2, i2, l) {
- var a1 = this.array;
- if (a1)
- for (var i = 0; i < l; i++) a2 [i2 + i] = a1 [i1 + i];
- else {
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- var l1 = this.last - i1;
- if (l <= l1)
- for (var i = 0; i < l; i++) a2 [i2 + i] = b.charCodeAt(i1 + i);
- else {
- for (var i = 0; i < l1; i++) a2 [i2 + i] = b.charCodeAt(i1 + i);
- for (; i < l; i++) a2 [i2 + i] = 0;
- }
- }
- },
- get:function (i) {
- var a = this.array;
- if (a) return a[i];
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- return (i= this.len)) caml_array_bound_error ();
- return this.get(i);
- },
- set:function (i, c) {
- var a = this.array;
- if (!a) {
- if (this.last == i) {
- this.bytes += String.fromCharCode (c & 0xff);
- this.last ++;
- return 0;
- }
- a = this.toArray();
- } else if (this.bytes != null) {
- this.bytes = this.fullBytes = this.string = null;
- }
- a[i] = c & 0xff;
- return 0;
- },
- safeSet:function (i, c) {
- if (this.len == null) this.toBytes ();
- if ((i < 0) || (i >= this.len)) caml_array_bound_error ();
- this.set(i, c);
- },
- fill:function (ofs, len, c) {
- if (ofs >= this.last && this.last && c == 0) return;
- var a = this.array;
- if (!a) a = this.toArray();
- else if (this.bytes != null) {
- this.bytes = this.fullBytes = this.string = null;
- }
- var l = ofs + len;
- for (var i = ofs; i < l; i++) a[i] = c;
- },
- compare:function (s2) {
- if (this.string != null && s2.string != null) {
- if (this.string < s2.string) return -1;
- if (this.string > s2.string) return 1;
- return 0;
- }
- var b1 = this.getFullBytes ();
- var b2 = s2.getFullBytes ();
- if (b1 < b2) return -1;
- if (b1 > b2) return 1;
- return 0;
- },
- equal:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string == s2.string;
- return this.getFullBytes () == s2.getFullBytes ();
- },
- lessThan:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string < s2.string;
- return this.getFullBytes () < s2.getFullBytes ();
- },
- lessEqual:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string <= s2.string;
- return this.getFullBytes () <= s2.getFullBytes ();
- }
-}
-function MlWrappedString (s) { this.string = s; }
-MlWrappedString.prototype = new MlString();
-function MlMakeString (l) { this.bytes = ""; this.len = l; }
-MlMakeString.prototype = new MlString ();
-function caml_array_get (array, index) {
- if ((index < 0) || (index >= array.length - 1)) caml_array_bound_error();
- return array[index+1];
-}
-function caml_array_set (array, index, newval) {
- if ((index < 0) || (index >= array.length - 1)) caml_array_bound_error();
- array[index+1]=newval; return 0;
-}
-function caml_blit_string(s1, i1, s2, i2, len) {
- if (len === 0) return;
- if (i2 === s2.last && s2.bytes != null) {
- var b = s1.bytes;
- if (b == null) b = s1.toBytes ();
- if (i1 > 0 || s1.last > len) b = b.slice(i1, i1 + len);
- s2.bytes += b;
- s2.last += b.length;
- return;
- }
- var a = s2.array;
- if (!a) a = s2.toArray(); else { s2.bytes = s2.string = null; }
- s1.blitToArray (i1, a, i2, len);
-}
-function caml_call_gen(f, args) {
- if(f.fun)
- return caml_call_gen(f.fun, args);
- var n = f.length;
- var d = n - args.length;
- if (d == 0)
- return f.apply(null, args);
- else if (d < 0)
- return caml_call_gen(f.apply(null, args.slice(0,n)), args.slice(n));
- else
- return function (x){ return caml_call_gen(f, args.concat([x])); };
-}
-function caml_classify_float (x) {
- if (isFinite (x)) {
- if (Math.abs(x) >= 2.2250738585072014e-308) return 0;
- if (x != 0) return 1;
- return 2;
- }
- return isNaN(x)?4:3;
-}
-function caml_create_string(len) {
- if (len < 0) caml_invalid_argument("String.create");
- return new MlMakeString(len);
-}
-function caml_int64_compare(x,y) {
- var x3 = x[3] << 16;
- var y3 = y[3] << 16;
- if (x3 > y3) return 1;
- if (x3 < y3) return -1;
- if (x[2] > y[2]) return 1;
- if (x[2] < y[2]) return -1;
- if (x[1] > y[1]) return 1;
- if (x[1] < y[1]) return -1;
- return 0;
-}
-function caml_int_compare (a, b) {
- if (a < b) return (-1); if (a == b) return 0; return 1;
-}
-function caml_compare_val (a, b, total) {
- var stack = [];
- for(;;) {
- if (!(total && a === b)) {
- if (a instanceof MlString) {
- if (b instanceof MlString) {
- if (a != b) {
- var x = a.compare(b);
- if (x != 0) return x;
- }
- } else
- return 1;
- } else if (a instanceof Array && a[0] === (a[0]|0)) {
- var ta = a[0];
- if (ta === 250) {
- a = a[1];
- continue;
- } else if (b instanceof Array && b[0] === (b[0]|0)) {
- var tb = b[0];
- if (tb === 250) {
- b = b[1];
- continue;
- } else if (ta != tb) {
- return (ta < tb)?-1:1;
- } else {
- switch (ta) {
- case 248: {
- var x = caml_int_compare(a[2], b[2]);
- if (x != 0) return x;
- break;
- }
- case 255: {
- var x = caml_int64_compare(a, b);
- if (x != 0) return x;
- break;
- }
- default:
- if (a.length != b.length) return (a.length < b.length)?-1:1;
- if (a.length > 1) stack.push(a, b, 1);
- }
- }
- } else
- return 1;
- } else if (b instanceof MlString ||
- (b instanceof Array && b[0] === (b[0]|0))) {
- return -1;
- } else {
- if (a < b) return -1;
- if (a > b) return 1;
- if (total && a != b) {
- if (a == a) return 1;
- if (b == b) return -1;
- }
- }
- }
- if (stack.length == 0) return 0;
- var i = stack.pop();
- b = stack.pop();
- a = stack.pop();
- if (i + 1 < a.length) stack.push(a, b, i + 1);
- a = a[i];
- b = b[i];
- }
-}
-function caml_equal (x, y) { return +(caml_compare_val(x,y,false) == 0); }
-function caml_fill_string(s, i, l, c) { s.fill (i, l, c); }
-function caml_parse_format (fmt) {
- fmt = fmt.toString ();
- var len = fmt.length;
- if (len > 31) caml_invalid_argument("format_int: format too long");
- var f =
- { justify:'+', signstyle:'-', filler:' ', alternate:false,
- base:0, signedconv:false, width:0, uppercase:false,
- sign:1, prec:6, conv:'f' };
- for (var i = 0; i < len; i++) {
- var c = fmt.charAt(i);
- switch (c) {
- case '-':
- f.justify = '-'; break;
- case '+': case ' ':
- f.signstyle = c; break;
- case '0':
- f.filler = '0'; break;
- case '#':
- f.alternate = true; break;
- case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9':
- f.width = 0;
- while (c=fmt.charCodeAt(i) - 48, c >= 0 && c <= 9) {
- f.width = f.width * 10 + c; i++
- }
- i--;
- break;
- case '.':
- f.prec = 0;
- i++;
- while (c=fmt.charCodeAt(i) - 48, c >= 0 && c <= 9) {
- f.prec = f.prec * 10 + c; i++
- }
- i--;
- case 'd': case 'i':
- f.signedconv = true; /* fallthrough */
- case 'u':
- f.base = 10; break;
- case 'x':
- f.base = 16; break;
- case 'X':
- f.base = 16; f.uppercase = true; break;
- case 'o':
- f.base = 8; break;
- case 'e': case 'f': case 'g':
- f.signedconv = true; f.conv = c; break;
- case 'E': case 'F': case 'G':
- f.signedconv = true; f.uppercase = true;
- f.conv = c.toLowerCase (); break;
- }
- }
- return f;
-}
-function caml_finish_formatting(f, rawbuffer) {
- if (f.uppercase) rawbuffer = rawbuffer.toUpperCase();
- var len = rawbuffer.length;
- if (f.signedconv && (f.sign < 0 || f.signstyle != '-')) len++;
- if (f.alternate) {
- if (f.base == 8) len += 1;
- if (f.base == 16) len += 2;
- }
- var buffer = "";
- if (f.justify == '+' && f.filler == ' ')
- for (var i = len; i < f.width; i++) buffer += ' ';
- if (f.signedconv) {
- if (f.sign < 0) buffer += '-';
- else if (f.signstyle != '-') buffer += f.signstyle;
- }
- if (f.alternate && f.base == 8) buffer += '0';
- if (f.alternate && f.base == 16) buffer += "0x";
- if (f.justify == '+' && f.filler == '0')
- for (var i = len; i < f.width; i++) buffer += '0';
- buffer += rawbuffer;
- if (f.justify == '-')
- for (var i = len; i < f.width; i++) buffer += ' ';
- return new MlWrappedString (buffer);
-}
-function caml_format_float (fmt, x) {
- var s, f = caml_parse_format(fmt);
- if (x < 0) { f.sign = -1; x = -x; }
- if (isNaN(x)) { s = "nan"; f.filler = ' '; }
- else if (!isFinite(x)) { s = "inf"; f.filler = ' '; }
- else
- switch (f.conv) {
- case 'e':
- var s = x.toExponential(f.prec);
- var i = s.length;
- if (s.charAt(i - 3) == 'e')
- s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
- break;
- case 'f':
- s = x.toFixed(f.prec); break;
- case 'g':
- var prec = f.prec?f.prec:1;
- s = x.toExponential(prec - 1);
- var j = s.indexOf('e');
- var exp = +s.slice(j + 1);
- if (exp < -4 || x.toFixed(0).length > prec) {
- var i = j - 1; while (s.charAt(i) == '0') i--;
- if (s.charAt(i) == '.') i--;
- s = s.slice(0, i + 1) + s.slice(j);
- i = s.length;
- if (s.charAt(i - 3) == 'e')
- s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
- break;
- } else {
- var p = prec;
- if (exp < 0) { p -= exp + 1; s = x.toFixed(p); }
- else while (s = x.toFixed(p), s.length > prec + 1) p--;
- if (p) {
- var i = s.length - 1; while (s.charAt(i) == '0') i--;
- if (s.charAt(i) == '.') i--;
- s = s.slice(0, i + 1);
- }
- }
- break;
- }
- return caml_finish_formatting(f, s);
-}
-function caml_format_int(fmt, i) {
- if (fmt.toString() == "%d") return new MlWrappedString(""+i);
- var f = caml_parse_format(fmt);
- if (i < 0) { if (f.signedconv) { f.sign = -1; i = -i; } else i >>>= 0; }
- var s = i.toString(f.base);
- return caml_finish_formatting(f, s);
-}
-function caml_compare (a, b) { return caml_compare_val (a, b, true); }
-function caml_greaterequal (x, y) { return +(caml_compare(x,y,false) >= 0); }
-function caml_int64_is_negative(x) {
- return (x[3] << 16) < 0;
-}
-function caml_int64_neg (x) {
- var y1 = - x[1];
- var y2 = - x[2] + (y1 >> 24);
- var y3 = - x[3] + (y2 >> 24);
- return [255, y1 & 0xffffff, y2 & 0xffffff, y3 & 0xffff];
-}
-function caml_int64_of_int32 (x) {
- return [255, x & 0xffffff, (x >> 24) & 0xffffff, (x >> 31) & 0xffff]
-}
-function caml_int64_ucompare(x,y) {
- if (x[3] > y[3]) return 1;
- if (x[3] < y[3]) return -1;
- if (x[2] > y[2]) return 1;
- if (x[2] < y[2]) return -1;
- if (x[1] > y[1]) return 1;
- if (x[1] < y[1]) return -1;
- return 0;
-}
-function caml_int64_lsl1 (x) {
- x[3] = (x[3] << 1) | (x[2] >> 23);
- x[2] = ((x[2] << 1) | (x[1] >> 23)) & 0xffffff;
- x[1] = (x[1] << 1) & 0xffffff;
-}
-function caml_int64_lsr1 (x) {
- x[1] = ((x[1] >>> 1) | (x[2] << 23)) & 0xffffff;
- x[2] = ((x[2] >>> 1) | (x[3] << 23)) & 0xffffff;
- x[3] = x[3] >>> 1;
-}
-function caml_int64_sub (x, y) {
- var z1 = x[1] - y[1];
- var z2 = x[2] - y[2] + (z1 >> 24);
- var z3 = x[3] - y[3] + (z2 >> 24);
- return [255, z1 & 0xffffff, z2 & 0xffffff, z3 & 0xffff];
-}
-function caml_int64_udivmod (x, y) {
- var offset = 0;
- var modulus = x.slice ();
- var divisor = y.slice ();
- var quotient = [255, 0, 0, 0];
- while (caml_int64_ucompare (modulus, divisor) > 0) {
- offset++;
- caml_int64_lsl1 (divisor);
- }
- while (offset >= 0) {
- offset --;
- caml_int64_lsl1 (quotient);
- if (caml_int64_ucompare (modulus, divisor) >= 0) {
- quotient[1] ++;
- modulus = caml_int64_sub (modulus, divisor);
- }
- caml_int64_lsr1 (divisor);
- }
- return [0,quotient, modulus];
-}
-function caml_int64_to_int32 (x) {
- return x[1] | (x[2] << 24);
-}
-function caml_int64_is_zero(x) {
- return (x[3]|x[2]|x[1]) == 0;
-}
-function caml_int64_format (fmt, x) {
- var f = caml_parse_format(fmt);
- if (f.signedconv && caml_int64_is_negative(x)) {
- f.sign = -1; x = caml_int64_neg(x);
- }
- var buffer = "";
- var wbase = caml_int64_of_int32(f.base);
- var cvtbl = "0123456789abcdef";
- do {
- var p = caml_int64_udivmod(x, wbase);
- x = p[1];
- buffer = cvtbl.charAt(caml_int64_to_int32(p[2])) + buffer;
- } while (! caml_int64_is_zero(x));
- return caml_finish_formatting(f, buffer);
-}
-function caml_parse_sign_and_base (s) {
- var i = 0, base = 10, sign = s.get(0) == 45?(i++,-1):1;
- if (s.get(i) == 48)
- switch (s.get(i + 1)) {
- case 120: case 88: base = 16; i += 2; break;
- case 111: case 79: base = 8; i += 2; break;
- case 98: case 66: base = 2; i += 2; break;
- }
- return [i, sign, base];
-}
-function caml_parse_digit(c) {
- if (c >= 48 && c <= 57) return c - 48;
- if (c >= 65 && c <= 90) return c - 55;
- if (c >= 97 && c <= 122) return c - 87;
- return -1;
-}
-var caml_global_data = [0];
-function caml_failwith (msg) {
- caml_raise_with_string(caml_global_data[3], msg);
-}
-function caml_int_of_string (s) {
- var r = caml_parse_sign_and_base (s);
- var i = r[0], sign = r[1], base = r[2];
- var threshold = -1 >>> 0;
- var c = s.get(i);
- var d = caml_parse_digit(c);
- if (d < 0 || d >= base) caml_failwith("int_of_string");
- var res = d;
- for (;;) {
- i++;
- c = s.get(i);
- if (c == 95) continue;
- d = caml_parse_digit(c);
- if (d < 0 || d >= base) break;
- res = base * res + d;
- if (res > threshold) caml_failwith("int_of_string");
- }
- if (i != s.getLen()) caml_failwith("int_of_string");
- res = sign * res;
- if ((res | 0) != res) caml_failwith("int_of_string");
- return res;
-}
-function caml_is_printable(c) { return +(c > 31 && c < 127); }
-function caml_js_from_byte_string (s) {return s.getFullBytes();}
-var caml_js_regexps = { amp:/&/g, lt:/ 0)?toArray.call (arguments):[undefined];
- return caml_call_gen(f, args);
- }
-}
-function caml_make_vect (len, init) {
- var b = [0]; for (var i = 1; i <= len; i++) b[i] = init; return b;
-}
-function MlStringFromArray (a) {
- var len = a.length; this.array = a; this.len = this.last = len;
-}
-MlStringFromArray.prototype = new MlString ();
-var caml_md5_string =
-function () {
- function add (x, y) { return (x + y) | 0; }
- function xx(q,a,b,x,s,t) {
- a = add(add(a, q), add(x, t));
- return add((a << s) | (a >>> (32 - s)), b);
- }
- function ff(a,b,c,d,x,s,t) {
- return xx((b & c) | ((~b) & d), a, b, x, s, t);
- }
- function gg(a,b,c,d,x,s,t) {
- return xx((b & d) | (c & (~d)), a, b, x, s, t);
- }
- function hh(a,b,c,d,x,s,t) { return xx(b ^ c ^ d, a, b, x, s, t); }
- function ii(a,b,c,d,x,s,t) { return xx(c ^ (b | (~d)), a, b, x, s, t); }
- function md5(buffer, length) {
- var i = length;
- buffer[i >> 2] |= 0x80 << (8 * (i & 3));
- for (i = (i & ~0x3) + 4;(i & 0x3F) < 56 ;i += 4)
- buffer[i >> 2] = 0;
- buffer[i >> 2] = length << 3;
- i += 4;
- buffer[i >> 2] = (length >> 29) & 0x1FFFFFFF;
- var w = [0x67452301, 0xEFCDAB89, 0x98BADCFE, 0x10325476];
- for(i = 0; i < buffer.length; i += 16) {
- var a = w[0], b = w[1], c = w[2], d = w[3];
- a = ff(a, b, c, d, buffer[i+ 0], 7, 0xD76AA478);
- d = ff(d, a, b, c, buffer[i+ 1], 12, 0xE8C7B756);
- c = ff(c, d, a, b, buffer[i+ 2], 17, 0x242070DB);
- b = ff(b, c, d, a, buffer[i+ 3], 22, 0xC1BDCEEE);
- a = ff(a, b, c, d, buffer[i+ 4], 7, 0xF57C0FAF);
- d = ff(d, a, b, c, buffer[i+ 5], 12, 0x4787C62A);
- c = ff(c, d, a, b, buffer[i+ 6], 17, 0xA8304613);
- b = ff(b, c, d, a, buffer[i+ 7], 22, 0xFD469501);
- a = ff(a, b, c, d, buffer[i+ 8], 7, 0x698098D8);
- d = ff(d, a, b, c, buffer[i+ 9], 12, 0x8B44F7AF);
- c = ff(c, d, a, b, buffer[i+10], 17, 0xFFFF5BB1);
- b = ff(b, c, d, a, buffer[i+11], 22, 0x895CD7BE);
- a = ff(a, b, c, d, buffer[i+12], 7, 0x6B901122);
- d = ff(d, a, b, c, buffer[i+13], 12, 0xFD987193);
- c = ff(c, d, a, b, buffer[i+14], 17, 0xA679438E);
- b = ff(b, c, d, a, buffer[i+15], 22, 0x49B40821);
- a = gg(a, b, c, d, buffer[i+ 1], 5, 0xF61E2562);
- d = gg(d, a, b, c, buffer[i+ 6], 9, 0xC040B340);
- c = gg(c, d, a, b, buffer[i+11], 14, 0x265E5A51);
- b = gg(b, c, d, a, buffer[i+ 0], 20, 0xE9B6C7AA);
- a = gg(a, b, c, d, buffer[i+ 5], 5, 0xD62F105D);
- d = gg(d, a, b, c, buffer[i+10], 9, 0x02441453);
- c = gg(c, d, a, b, buffer[i+15], 14, 0xD8A1E681);
- b = gg(b, c, d, a, buffer[i+ 4], 20, 0xE7D3FBC8);
- a = gg(a, b, c, d, buffer[i+ 9], 5, 0x21E1CDE6);
- d = gg(d, a, b, c, buffer[i+14], 9, 0xC33707D6);
- c = gg(c, d, a, b, buffer[i+ 3], 14, 0xF4D50D87);
- b = gg(b, c, d, a, buffer[i+ 8], 20, 0x455A14ED);
- a = gg(a, b, c, d, buffer[i+13], 5, 0xA9E3E905);
- d = gg(d, a, b, c, buffer[i+ 2], 9, 0xFCEFA3F8);
- c = gg(c, d, a, b, buffer[i+ 7], 14, 0x676F02D9);
- b = gg(b, c, d, a, buffer[i+12], 20, 0x8D2A4C8A);
- a = hh(a, b, c, d, buffer[i+ 5], 4, 0xFFFA3942);
- d = hh(d, a, b, c, buffer[i+ 8], 11, 0x8771F681);
- c = hh(c, d, a, b, buffer[i+11], 16, 0x6D9D6122);
- b = hh(b, c, d, a, buffer[i+14], 23, 0xFDE5380C);
- a = hh(a, b, c, d, buffer[i+ 1], 4, 0xA4BEEA44);
- d = hh(d, a, b, c, buffer[i+ 4], 11, 0x4BDECFA9);
- c = hh(c, d, a, b, buffer[i+ 7], 16, 0xF6BB4B60);
- b = hh(b, c, d, a, buffer[i+10], 23, 0xBEBFBC70);
- a = hh(a, b, c, d, buffer[i+13], 4, 0x289B7EC6);
- d = hh(d, a, b, c, buffer[i+ 0], 11, 0xEAA127FA);
- c = hh(c, d, a, b, buffer[i+ 3], 16, 0xD4EF3085);
- b = hh(b, c, d, a, buffer[i+ 6], 23, 0x04881D05);
- a = hh(a, b, c, d, buffer[i+ 9], 4, 0xD9D4D039);
- d = hh(d, a, b, c, buffer[i+12], 11, 0xE6DB99E5);
- c = hh(c, d, a, b, buffer[i+15], 16, 0x1FA27CF8);
- b = hh(b, c, d, a, buffer[i+ 2], 23, 0xC4AC5665);
- a = ii(a, b, c, d, buffer[i+ 0], 6, 0xF4292244);
- d = ii(d, a, b, c, buffer[i+ 7], 10, 0x432AFF97);
- c = ii(c, d, a, b, buffer[i+14], 15, 0xAB9423A7);
- b = ii(b, c, d, a, buffer[i+ 5], 21, 0xFC93A039);
- a = ii(a, b, c, d, buffer[i+12], 6, 0x655B59C3);
- d = ii(d, a, b, c, buffer[i+ 3], 10, 0x8F0CCC92);
- c = ii(c, d, a, b, buffer[i+10], 15, 0xFFEFF47D);
- b = ii(b, c, d, a, buffer[i+ 1], 21, 0x85845DD1);
- a = ii(a, b, c, d, buffer[i+ 8], 6, 0x6FA87E4F);
- d = ii(d, a, b, c, buffer[i+15], 10, 0xFE2CE6E0);
- c = ii(c, d, a, b, buffer[i+ 6], 15, 0xA3014314);
- b = ii(b, c, d, a, buffer[i+13], 21, 0x4E0811A1);
- a = ii(a, b, c, d, buffer[i+ 4], 6, 0xF7537E82);
- d = ii(d, a, b, c, buffer[i+11], 10, 0xBD3AF235);
- c = ii(c, d, a, b, buffer[i+ 2], 15, 0x2AD7D2BB);
- b = ii(b, c, d, a, buffer[i+ 9], 21, 0xEB86D391);
- w[0] = add(a, w[0]);
- w[1] = add(b, w[1]);
- w[2] = add(c, w[2]);
- w[3] = add(d, w[3]);
- }
- var t = [];
- for (var i = 0; i < 4; i++)
- for (var j = 0; j < 4; j++)
- t[i * 4 + j] = (w[i] >> (8 * j)) & 0xFF;
- return t;
- }
- return function (s, ofs, len) {
- var buf = [];
- if (s.array) {
- var a = s.array;
- for (var i = 0; i < len; i+=4) {
- var j = i + ofs;
- buf[i>>2] = a[j] | (a[j+1] << 8) | (a[j+2] << 16) | (a[j+3] << 24);
- }
- for (; i < len; i++) buf[i>>2] |= a[i + ofs] << (8 * (i & 3));
- } else {
- var b = s.getFullBytes();
- for (var i = 0; i < len; i+=4) {
- var j = i + ofs;
- buf[i>>2] =
- b.charCodeAt(j) | (b.charCodeAt(j+1) << 8) |
- (b.charCodeAt(j+2) << 16) | (b.charCodeAt(j+3) << 24);
- }
- for (; i < len; i++) buf[i>>2] |= b.charCodeAt(i + ofs) << (8 * (i & 3));
- }
- return new MlStringFromArray(md5(buf, len));
- }
-} ();
-function caml_ml_out_channels_list () { return 0; }
-function caml_raise_constant (tag) { throw [0, tag]; }
-function caml_raise_zero_divide () {
- caml_raise_constant(caml_global_data[6]);
-}
-function caml_mod(x,y) {
- if (y == 0) caml_raise_zero_divide ();
- return x%y;
-}
-function caml_mul(x,y) {
- return ((((x >> 16) * y) << 16) + (x & 0xffff) * y)|0;
-}
-function caml_register_global (n, v) { caml_global_data[n + 1] = v; }
-var caml_named_values = {};
-function caml_register_named_value(nm,v) {
- caml_named_values[nm] = v; return 0;
-}
-function caml_string_equal(s1, s2) {
- var b1 = s1.fullBytes;
- var b2 = s2.fullBytes;
- if (b1 != null && b2 != null) return (b1 == b2)?1:0;
- return (s1.getFullBytes () == s2.getFullBytes ())?1:0;
-}
-function caml_string_notequal(s1, s2) { return 1-caml_string_equal(s1, s2); }
-function caml_sys_get_config () {
- return [0, new MlWrappedString("Unix"), 32];
-}
-var caml_initial_time = new Date() * 0.001;
-function caml_sys_time () { return new Date() * 0.001 - caml_initial_time; }
-function caml_update_dummy (x, y) {
- if( typeof y==="function" ) { x.fun = y; return 0; }
- if( y.fun ) { x.fun = y.fun; return 0; }
- var i = y.length; while (i--) x[i] = y[i]; return 0;
-}
-(function(){function iY(vz,vA,vB,vC,vD,vE,vF){return vz.length==6?vz(vA,vB,vC,vD,vE,vF):caml_call_gen(vz,[vA,vB,vC,vD,vE,vF]);}function rh(vu,vv,vw,vx,vy){return vu.length==4?vu(vv,vw,vx,vy):caml_call_gen(vu,[vv,vw,vx,vy]);}function eG(vq,vr,vs,vt){return vq.length==3?vq(vr,vs,vt):caml_call_gen(vq,[vr,vs,vt]);}function e_(vn,vo,vp){return vn.length==2?vn(vo,vp):caml_call_gen(vn,[vo,vp]);}function ce(vl,vm){return vl.length==1?vl(vm):caml_call_gen(vl,[vm]);}var a=[0,new MlString("Failure")],b=[0,new MlString("Invalid_argument")],c=[0,new MlString("Not_found")],d=[0,new MlString("Assert_failure")],e=new MlString("select");caml_register_global(5,[0,new MlString("Division_by_zero")]);caml_register_global(3,b);caml_register_global(2,a);var bX=new MlString("%.12g"),bW=new MlString("."),bV=new MlString("%d"),bU=new MlString("true"),bT=new MlString("false"),bS=new MlString("Pervasives.do_at_exit"),bR=new MlString("nth"),bQ=new MlString("List.nth"),bP=new MlString("\\b"),bO=new MlString("\\t"),bN=new MlString("\\n"),bM=new MlString("\\r"),bL=new MlString("\\\\"),bK=new MlString("\\'"),bJ=new MlString(""),bI=new MlString("String.blit"),bH=new MlString("String.sub"),bG=new MlString("Queue.Empty"),bF=new MlString("Buffer.add: cannot grow buffer"),bE=new MlString("%"),bD=new MlString(""),bC=new MlString(""),bB=new MlString("\""),bA=new MlString("\""),bz=new MlString("'"),by=new MlString("'"),bx=new MlString("."),bw=new MlString("printf: bad positional specification (0)."),bv=new MlString("%_"),bu=[0,new MlString("printf.ml"),144,8],bt=new MlString("''"),bs=new MlString("Printf: premature end of format string ``"),br=new MlString("''"),bq=new MlString(" in format string ``"),bp=new MlString(", at char number "),bo=new MlString("Printf: bad conversion %"),bn=new MlString("Sformat.index_of_int: negative argument "),bm=new MlString("x"),bl=new MlString("Lwt_sequence.Empty"),bk=[0,new MlString("src/core/lwt.ml"),499,20],bj=[0,new MlString("src/core/lwt.ml"),502,8],bi=[0,new MlString("src/core/lwt.ml"),477,20],bh=[0,new MlString("src/core/lwt.ml"),480,8],bg=[0,new MlString("src/core/lwt.ml"),440,20],bf=[0,new MlString("src/core/lwt.ml"),443,8],be=new MlString("Lwt.fast_connect"),bd=new MlString("Lwt.connect"),bc=new MlString("Lwt.wakeup_exn"),bb=new MlString("Lwt.wakeup"),ba=new MlString("Lwt.Canceled"),a$=new MlString("table"),a_=new MlString("img"),a9=new MlString("br"),a8=new MlString("h1"),a7=new MlString("div"),a6=new MlString("option"),a5=new MlString("\""),a4=new MlString(" name=\""),a3=new MlString("\""),a2=new MlString(" type=\""),a1=new MlString("<"),a0=new MlString(">"),aZ=new MlString(""),aY=new MlString("\\$&"),aX=new MlString("$$$$"),aW=new MlString("g"),aV=new MlString("g"),aU=new MlString("[$]"),aT=new MlString("[\\][()\\\\|+*.?{}^$]"),aS=[0,new MlString(""),0],aR=new MlString(""),aQ=new MlString("="),aP=new MlString("&"),aO=new MlString("%2B"),aN=new MlString("Url.Local_exn"),aM=new MlString("+"),aL=new MlString("^([Hh][Tt][Tt][Pp][Ss]?)://([0-9a-zA-Z.-]+|\\[[0-9a-zA-Z.-]+\\]|\\[[0-9A-Fa-f:.]+\\])?(:([0-9]+))?/([^\\?#]*)(\\?([^#])*)?(#(.*))?$"),aK=new MlString("^([Ff][Ii][Ll][Ee])://([^\\?#]*)(\\?([^#])*)?(#(.*))?$"),aJ=new MlString("browser can't read file: unimplemented"),aI=new MlString("utf8"),aH=[0,new MlString("file.ml"),109,15],aG=new MlString("string"),aF=new MlString("can't retrieve file name: not implemented"),aE=new MlString(""),aD=new MlString("POST"),aC=new MlString("multipart/form-data; boundary="),aB=new MlString("POST"),aA=[0,new MlString("POST"),[0,new MlString("application/x-www-form-urlencoded")],126925477],az=[0,new MlString("POST"),0,126925477],ay=new MlString("GET"),ax=new MlString("?"),aw=new MlString("Content-type"),av=new MlString("="),au=new MlString("="),at=new MlString("&"),as=new MlString("Content-Type: application/octet-stream\r\n"),ar=new MlString("\"\r\n"),aq=new MlString("\"; filename=\""),ap=new MlString("Content-Disposition: form-data; name=\""),ao=new MlString("\r\n"),an=new MlString("\r\n"),am=new MlString("\r\n"),al=new MlString("--"),ak=new MlString("\r\n"),aj=new MlString("\"\r\n\r\n"),ai=new MlString("Content-Disposition: form-data; name=\""),ah=new MlString("--\r\n"),ag=new MlString("--"),af=new MlString("js_of_ocaml-------------------"),ae=new MlString("Msxml2.XMLHTTP"),ad=new MlString("Msxml3.XMLHTTP"),ac=new MlString("Microsoft.XMLHTTP"),ab=[0,new MlString("xmlHttpRequest.ml"),64,2],aa=new MlString("XmlHttpRequest.Wrong_headers"),$=new MlString("sprites/guy.png"),_=new MlString("sprites/boulder.png"),Z=new MlString("index out of bounds"),Y=new MlString("YOU WIN !"),X=new MlString("YOU LOSE !"),W=new MlString("sprites/end.png"),V=new MlString("sprites/R.png"),U=new MlString("sprites/L.png"),T=new MlString("sprites/U.png"),S=new MlString("sprites/D.png"),R=new MlString("sprites/push_r.png"),Q=new MlString("sprites/bR.png"),P=new MlString("sprites/push_l.png"),O=new MlString("sprites/bL.png"),N=new MlString("eos"),M=new MlString("eos"),L=new MlString("eos"),K=new MlString("%g"),J=new MlString("1"),I=new MlString("malformed level"),H=new MlString("border-collapse:collapse;line-height: 0; opacity: 0; margin-left:auto; margin-right:auto"),G=new MlString("padding: 0; width: 20px; height: 20px;"),F=new MlString("font-family: sans-serif; text-align: center; background-color: #e8e8e8;"),E=new MlString("Boulder Dash in Ocaml"),D=new MlString("Elapsed time: "),C=new MlString(" Remaining diamonds: "),B=new MlString(" "),A=new MlString("Choose a level"),z=[0,new MlString("boulderdash.ml"),294,17],y=new MlString("boulderdash"),x=new MlString("--"),w=new MlString("maps.txt"),v=new MlString("sprites/empty.png"),u=new MlString("sprites/grass.png"),t=new MlString("sprites/diamond.png"),s=new MlString("sprites/boulder.png"),r=new MlString("sprites/door.png"),q=new MlString("sprites/end.png"),p=new MlString("sprites/guy.png"),o=new MlString("sprites/wall.png"),n=new MlString("sprites/bam.png"),m=new MlString("%02d:%02d:%02d"),l=new MlString("--:--:--"),k=new MlString("LOADING..."),j=new MlString("border: 1px black solid; background-color: white ; display: inline ; padding-right: .5em; padding-left: .5em;"),i=new MlString("background-color: red; color: white; display:inline; position: absolute; top:0; right:0;"),h=new MlString("Boulderdash.Death");function g(f){throw [0,a,f];}function bZ(bY){throw [0,b,bY];}function b5(b0,b2){var b1=b0.getLen(),b3=b2.getLen(),b4=caml_create_string(b1+b3|0);caml_blit_string(b0,0,b4,0,b1);caml_blit_string(b2,0,b4,b1,b3);return b4;}function b7(b6){return caml_format_int(bV,b6);}function ca(b$){var b8=caml_ml_out_channels_list(0);for(;;){if(b8){var b9=b8[2];try {}catch(b_){}var b8=b9;continue;}return 0;}}caml_register_named_value(bS,ca);function ck(cd,cb){var cc=cb.length-1;if(0===cc)return [0];var cf=caml_make_vect(cc,ce(cd,cb[0+1])),cg=1,ch=cc-1|0;if(!(ch>1,b);return c+c}function
+r(a){if(a!=null){this.bytes=this.fullBytes=a;this.last=this.len=a.length}}function
+d1(){d0(g[4],new
+r(b8))}r.prototype={string:null,bytes:null,fullBytes:null,array:null,len:null,last:0,toJsString:function(){var
+a=this.getFullBytes();try{return this.string=decodeURIComponent(escape(a))}catch(f){cc('MlString.toJsString: wrong encoding for "%s" ',a);return a}},toBytes:function(){if(this.string!=null)try{var
+a=unescape(encodeURIComponent(this.string))}catch(f){cc('MlString.toBytes: wrong encoding for "%s" ',this.string);var
+a=this.string}else{var
+a=d,c=this.array,e=c.length;for(var
+b=0;b=0;e--)b[c+e]=g[a+e];else{var
+f=this.bytes;if(f==null)f=this.toBytes();var
+h=this.last-a;if(d<=h)for(var
+e=0;e=this.len)d1();return this.get(a)},set:function(a,b){var
+c=this.array;if(!c){if(this.last==a){this.bytes+=String.fromCharCode(b&af);this.last++;return 0}c=this.toArray()}else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;c[a]=breturn 0},safeSet:function(a,b){if(this.len==null)this.toBytes();if(a<0||a>=this.len)d1();this.set(a,b)},fill:function(a,b,c){if(a>=this.last&&this.last&&c==0)return;var
+d=this.array;if(!d)d=this.toArray();else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;var
+f=a+b;for(var
+e=a;ea.string)return 1;return 0}var
+b=this.getFullBytes(),c=a.getFullBytes();if(bc)return 1;return 0},equal:function(a){if(this.string!=null&&a.string!=null)return this.string==a.string;return this.getFullBytes()==a.getFullBytes()},lessThan:function(a){if(this.string!=null&&a.string!=null)return this.string=a.length-1)dN();return a[b+1]}function
+hD(a,b,c){if(b<0||b>=a.length-1)dN();a[b+1]=c;return 0}function
+dO(a,b,c,d,e){if(e===0)return;if(d===c.last&&c.bytes!=null){var
+f=a.bytes;if(f==null)f=a.toBytes();if(b>0||a.last>e)f=f.slice(b,b+e);c.bytes+=f;c.last+=f.length;return}var
+g=c.array;if(!g)g=c.toArray();else
+c.bytes=c.string=null;a.blitToArray(b,g,d,e)}function
+Y(c,b){if(c.fun)return Y(c.fun,b);var
+a=c.length,d=a-b.length;if(d==0)return c.apply(null,b);else
+if(d<0)return Y(c.apply(null,b.slice(0,a)),b.slice(a));else
+return function(a){return Y(c,b.concat([a]))}}function
+hE(a){if(isFinite(a)){if(Math.abs(a)>=2.22507385850720138e-308)return 0;if(a!=0)return 1;return 2}return isNaN(a)?4:3}function
+hF(){return 0}function
+dL(a){this.bytes=d;this.len=a}dL.prototype=new
+r();function
+dQ(a){if(a<0)as("String.create");return new
+dL(a)}function
+hO(a,b){var
+c=a[3]<<16,d=b[3]<<16;if(c>d)return 1;if(cb[2])return 1;if(a[2]b[1])return 1;if(a[1]1)e.push(a,b,1)}}else
+return 1}else
+if(b
+instanceof
+r||b
+instanceof
+Array&&b[0]===(b[0]|0))return-1;else
+if(typeof
+a!=z&&a&&a.compare)return a.compare(b,c);else{if(ab)return 1;if(a!=b){if(!c)return NaN;if(a==a)return 1;if(b==b)return-1}}if(e.length==0)return 0;var
+h=e.pop();b=e.pop();a=e.pop();if(h+131)as("format_int: format too long");var
+b={justify:aJ,signstyle:ag,filler:F,alternate:false,base:0,signedconv:false,width:0,uppercase:false,sign:1,prec:-1,conv:bV};for(var
+d=0;d=0&&c<=9){b.width=b.width*10+c;d++}d--;break;case
+aq:b.prec=0;d++;while(c=a.charCodeAt(d)-48,c>=0&&c<=9){b.prec=b.prec*10+c;d++}d--;case"d":case"i":b.signedconv=true;case"u":b.base=10;break;case
+ds:b.base=16;break;case"X":b.base=16;b.uppercase=true;break;case"o":b.base=8;break;case
+aK:case
+bV:case
+aI:b.signedconv=true;b.conv=c;break;case"E":case"F":case"G":b.signedconv=true;b.uppercase=true;b.conv=c.toLowerCase();break}}return b}function
+b$(a,b){if(a.uppercase)b=b.toUpperCase();var
+f=b.length;if(a.signedconv&&(a.sign<0||a.signstyle!=ag))f++;if(a.alternate){if(a.base==8)f+=1;if(a.base==16)f+=2}var
+c=d;if(a.justify==aJ&&a.filler==F)for(var
+e=f;ee){var
+d=i-1;while(c.charAt(d)==G)d--;if(c.charAt(d)==aq)d--;c=c.slice(0,d+1)+c.slice(i);d=c.length;if(c.charAt(d-3)==aK)c=c.slice(0,d-1)+G+c.slice(d-1);break}else{var
+g=e;if(h<0){g-=h+1;c=b.toFixed(g)}else
+while(c=b.toFixed(g),c.length>e+1)g--;if(g){var
+d=c.length-1;while(c.charAt(d)==G)d--;if(c.charAt(d)==aq)d--;c=c.slice(0,d+1)}}break}return b$(f,c)}function
+hK(a,b){if(a.toString()==dr)return new
+H(d+b);var
+c=ca(a);if(b<0)if(c.signedconv){c.sign=-1;b=-b}else
+b>>>=0;var
+e=b.toString(c.base);if(c.prec>=0){c.filler=F;var
+f=c.prec-e.length;if(f>0)e=aO(f,G)+e}return b$(c,e)}function
+ih(a){throw[0,a]}function
+ii(){ih(g[7])}function
+dM(a){var
+b=a.length;this.array=a;this.len=this.last=b}dM.prototype=new
+r();function
+ai(){this.content={}}ai.prototype={exists:function(a){return this.content[a]?1:0},mk:function(a,b){this.content[a]=b},get:function(a){return this.content[a]},list:function(){var
+a=[];for(var
+b
+in
+this.content)a.push(b);return a},remove:function(a){delete
+this.content[a]}};var
+bp=new
+ai();bp.mk(d,new
+ai());function
+I(a){cb(g[2],a)}function
+dZ(a){a=a
+instanceof
+r?a.toString():a;I(a+": No such file or directory")}function
+bm(a){var
+b=bp;for(var
+c=0;c1)b.pop();break;case
+aq:case
+d:if(b.length==0)b.push(d);break;default:b.push(e[c]);break}b.orig=a;return b}function
+ar(a){this.data=a}ar.prototype={content:function(){return this.data},truncate:function(){this.data.length=0}};function
+hL(a){var
+c=aN(a),b=bm(c);if(b
+instanceof
+ar)return new
+dM(b.content());ii()}function
+dR(a,b){var
+e=aN(a),c=bp;for(var
+f=0;f>24&K,a>>31&bg]}function
+hV(a,b){var
+c=a[1]-b[1],d=a[2]-b[2]+(c>>24),e=a[3]-b[3]+(d>>24);return[af,c&K,d&K,e&bg]}function
+dT(a,b){if(a[3]>b[3])return 1;if(a[3]b[2])return 1;if(a[2]b[1])return 1;if(a[1]>23;a[2]=(a[2]<<1|a[1]>>23)&K;a[1]=a[1]<<1&K}function
+hS(a){a[1]=(a[1]>>>1|a[2]<<23)&K;a[2]=(a[2]>>>1|a[3]<<23)&K;a[3]=a[3]>>>1}function
+hX(a,b){var
+e=0,d=a.slice(),c=b.slice(),f=[af,0,0,0];while(dT(d,c)>0){e++;dS(c)}while(e>=0){e--;dS(f);if(dT(d,c)>=0){f[1]++;d=hV(d,c)}hS(c)}return[0,f,d]}function
+hW(a){return a[1]|a[2]<<24}function
+hQ(a){return a[3]<<16<0}function
+hT(a){var
+b=-a[1],c=-a[2]+(b>>24),d=-a[3]+(c>>24);return[af,b&K,c&K,d&bg]}function
+hP(a,b){var
+c=ca(a);if(c.signedconv&&hQ(b)){c.sign=-1;b=hT(b)}var
+e=d,i=hU(c.base),h="0123456789abcdef";do{var
+g=hX(b,i);b=g[1];e=h.charAt(hW(g[2]))+e}while(!hR(b));if(c.prec>=0){c.filler=F;var
+f=c.prec-e.length;if(f>0)e=aO(f,G)+e}return b$(c,e)}function
+ig(a){var
+b=0,c=10,d=a.get(0)==45?(b++,-1):1;if(a.get(b)==48)switch(a.get(b+1)){case
+b0:case
+88:c=16;b+=2;break;case
+b4:case
+79:c=8;b+=2;break;case
+98:case
+66:c=2;b+=2;break}return[b,d,c]}function
+dY(a){if(a>=48&&a<=57)return a-48;if(a>=65&&a<=90)return a-55;if(a>=97&&a<=122)return a-87;return-1}function
+hZ(a){var
+g=ig(a),f=g[0],h=g[1],d=g[2],i=-1>>>0,e=a.get(f),c=dY(e);if(c<0||c>=d)bl(ba);var
+b=c;for(;;){f++;e=a.get(f);if(e==95)continue;c=dY(e);if(c<0||c>=d)break;b=d*b+c;if(b>i)bl(ba)}if(f!=a.getLen())bl(ba);b=h*b;if(d==10&&(b|0)!=b)bl(ba);return b|0}function
+h0(a){return+(a>31&&a<127)}function
+h1(a){return a.getFullBytes()}function
+h2(){var
+c=b.console?b.console:{},d=["log","debug","info","warn","error","assert","dir","dirxml","trace","group","groupCollapsed","groupEnd","time","timeEnd"];function
+e(){}for(var
+a=0;a0?c.call(arguments):[undefined];return Y(a,b)}}function
+h7(a,b){var
+d=[0];for(var
+c=1;c<=a;c++)d[c]=b;return d}function
+dU(a){if(!a.opened)I("Cannot flush a closed channel");if(a.buffer==d)return 0;if(a.output)switch(a.output.length){case
+2:a.output(a,a.buffer);break;default:a.output(a.buffer)}a.buffer=d}function
+is(a){var
+c=aN(a),b=bm(c);return b
+instanceof
+ai?1:0}function
+ir(a){var
+b=bp,d=aN(a),e;for(var
+c=0;c>16)*b<<16)+(a&bg)*b|0};var
+ia=Math.imul;function
+ic(a,b){return+(dP(a,b,false)!=0)}function
+id(a){return+(a
+instanceof
+Array)}function
+ie(a){return a
+instanceof
+Array?a[0]:dz}function
+ij(a,b){g[a+1]=b}var
+dW={};function
+ik(a,b){dW[a.toString()]=b;return 0}function
+im(a,b){var
+c=a.fullBytes,d=b.fullBytes;if(c!=null&&d!=null)return c==d?1:0;return a.getFullBytes()==b.getFullBytes()?1:0}function
+io(a,b){return 1-im(a,b)}function
+ip(){return 32}function
+iq(a){if(b.quit)b.quit(a);as("Function 'exit' not implemented")}var
+hN=new
+Date()*dj;function
+it(){return new
+Date()*dj-hN}function
+iu(a){var
+b=1;while(a&&a.joo_tramp){a=a.joo_tramp.apply(null,a.joo_args);b++}return a}function
+iv(a,b){return{joo_tramp:a,joo_args:b}}function
+iw(a,b){if(typeof
+b==="function"){a.fun=b;return 0}if(b.fun){a.fun=b.fun;return 0}var
+c=b.length;while(c--)a[c]=b[c];return 0}function
+ib(a){return dW[a]}function
+ix(a){if(a
+instanceof
+Array)return a;if(b.RangeError&&a
+instanceof
+b.RangeError&&a.message&&a.message.match(/maximum call stack/i))return[0,g[9]];if(b.InternalError&&a
+instanceof
+b.InternalError&&a.message&&a.message.match(/too much recursion/i))return[0,g[9]];if(a
+instanceof
+b.Error)return[0,ib(du),a];return[0,g[3],new
+H(String(a))]}var
+h=hC,k=hD,ad=dO,Q=dQ,dg=hH,bQ=hJ,a6=hK,ao=dR,dd=hZ,bR=h0,q=h1,dh=h3,V=h5,a9=h6,R=h7,c$=dU,c_=h9,db=h$,dc=ia,c=dX,de=ie,a=ij,da=ik,C=io,aH=it,a8=iu,T=iv,df=iw,y=ix;function
+j(a,b){return a.length==1?a(b):Y(a,[b])}function
+o(a,b,c){return a.length==2?a(b,c):Y(a,[b,c])}function
+u(a,b,c,d){return a.length==3?a(b,c,d):Y(a,[b,c,d])}function
+a7(a,b,c,d,e,f){return a.length==5?a(b,c,d,e,f):Y(a,[b,c,d,e,f])}ao("/maps.txt",'"maps/level0.map"\t"Level without boulders"\n"maps/level1.map"\t"Simple falls"\n"maps/level2.map"\t"More falls"\n"maps/level3.map"\t"Real (yet little) puzzle"\n"maps/level4.map"\t"Bigger puzzle (copie de BeeDeeDash)"\n');ao("/maps/level4.map","########################################\n#...... ..+.X .....X.X....... ....X....#\n#.XSX...... .........X+..X.... ..... ..#\n#.......... ..X.....X.X..X........X....#\n#X.XX.........X......X..X....X...X.....#\n#X. X......... X..X........X......X.XX.#\n#... ..X........X.....X. X........X.XX.#\n###############################...X..X.#\n#. ...X..+. ..X.X..........+.X+...... .#\n#..+.....X..... ........XX X..X....X...#\n#...X..X.X..............X .X..X........#\n#.X.....X........XXX.......X.. .+....X.#\n#.+.. ..X. .....X.X+..+....X...X..+. .#\n#. X..............X X..X........+.....X#\n#........###############################\n# X.........X...+....X.....X...X.......#\n# X......... X..X........X......X.XX..E#\n#. ..X........X.....X. ....+...X.XX...#\n#....X+..X........X......X.X+......X...#\n#... ..X. ..X.XX.........X.X+...... ..X#\n#.+.... ..... ......... .X..X....X...X.#\n########################################\n");ao("/maps/level3.map","##############\n#XXXX# #\n#XXX+# + #\n#X..S# X## #\n#+ +X+# #\n# #X#X# #\n# +E.... #\n# #++ #\n##############\n");ao("/maps/level2.map","####################\n#S# XXXXX #\n# # XX .XXX. #\n# # .XX. .X. #\n# # +. + #\n# ## XX #\n# +X. E#\n####################\n");ao("/maps/level1.map","##################\n#S X # #\n# + #.X..XX....#\n# X #.+..++....#\n# + # + #\n# # XX #\n# . +. E#\n##################\n");ao("/maps/level0.map","###################\n#S........+.......#\n#+....+.........+##\n#...+........+.#.E#\n###################\n");var
+at=[0,c("Failure")],bq=[0,c("Invalid_argument")],aQ=[0,c("Not_found")],cz=[0,c("Match_failure")],cy=[0,c("Stack_overflow")],v=[0,c("Assert_failure")],cA=[0,c("Undefined_recursive_module")],by=c('File "%s", line %d, characters %d-%d: %s'),cY=c(dC);a(11,cA);a(8,cy);a(7,cz);a(6,aQ);a(5,[0,c("Division_by_zero")]);a(4,[0,c("End_of_file")]);a(3,bq);a(2,at);a(1,[0,c("Sys_error")]);var
+eQ=[0,c("Out_of_memory")],d5=c(dv),d4=c(aq),d2=c("true"),d3=c("false"),d6=c("Pervasives.do_at_exit"),d8=c("nth"),d9=c("List.nth"),ea=c("\\b"),eb=c("\\t"),ec=c("\\n"),ed=c("\\r"),d$=c("\\\\"),d_=c("\\'"),eg=c(d),ef=c("String.blit"),ee=c("String.sub"),eh=c("Queue.Empty"),ej=c("Buffer.add: cannot grow buffer"),ez=c(d),eA=c(d),eD=c(dv),eE=c(bc),eF=c(bc),eB=c(bb),eC=c(bb),ey=c(dw),ew=c("neg_infinity"),ex=c("infinity"),ev=c(aq),eu=c("printf: bad positional specification (0)."),et=c("%_"),es=[0,c("printf.ml"),143,8],eq=c(bb),er=c("Printf: premature end of format string '"),em=c(bb),en=c(" in format string '"),eo=c(", at char number "),ep=c("Printf: bad conversion %"),ek=c("Sformat.index_of_int: negative argument "),eK=c(d),eL=c(", %s%s"),e2=[1,1],e3=c("%s\n"),e4=c("(Program not linked with -g, cannot print stack backtrace)\n"),eW=c("Raised at"),eZ=c("Re-raised at"),e0=c("Raised by primitive operation at"),e1=c("Called from"),eX=c('%s file "%s", line %d, characters %d-%d'),eY=c("%s unknown location"),eR=c("Out of memory"),eS=c("Stack overflow"),eT=c("Pattern matching failed"),eU=c("Assertion failed"),eV=c("Undefined recursive module"),eM=c("(%s%s)"),eN=c(d),eO=c(d),eP=c("(%s)"),eJ=c(dr),eH=c("%S"),eI=c("_"),e5=c("Lwt_sequence.Empty"),fi=[0,c(X),692,20],fj=[0,c(X),695,8],fg=[0,c(X),670,20],fh=[0,c(X),673,8],fe=[0,c(X),648,20],ff=[0,c(X),651,8],fc=[0,c(X),498,8],fb=[0,c(X),487,9],fa=c("Lwt.wakeup_later_result"),e$=c("Lwt.wakeup_result"),e8=c("Fatal error: exception "),e7=c("Lwt.Canceled"),fd=[0,0],fo=c("Js.Error"),fp=c(du),fw=c("table"),fv=c("img"),fu=c("br"),ft=c("h1"),fs=c("div"),fr=c("option"),fA=c("browser can't read file: unimplemented"),fz=[0,c("file.ml"),131,15],fx=c("can't retrieve file name: not implemented"),fD=c("Exception during Lwt.async: "),fF=c("[\\][()\\\\|+*.?{}^$]"),fS=[0,c(d),0],fT=c(d),f6=c(d),f7=c(bd),gd=c(d),f8=c(a_),gc=c(d),f9=c(W),f_=c(W),gb=c(di),f$=c(d),ga=c("http://"),ge=c(d),gf=c(bd),gn=c(d),gg=c(a_),gm=c(d),gh=c(W),gi=c(W),gl=c(di),gj=c(d),gk=c("https://"),go=c(d),gp=c(bd),gu=c(d),gq=c(a_),gt=c(d),gr=c(W),gs=c("file://"),f5=c(d),f4=c(d),f3=c(d),f2=c(d),f1=c(d),f0=c(d),fU=c(b1),fV=c(dH),fM=c("file"),fN=c("file:"),fO=c("http"),fP=c("http:"),fQ=c("https"),fR=c("https:"),fJ=c("%2B"),fH=c("Url.Local_exn"),fI=c(aJ),fK=c("Url.Not_an_http_protocol"),fW=c("^([Hh][Tt][Tt][Pp][Ss]?)://([0-9a-zA-Z.-]+|\\[[0-9a-zA-Z.-]+\\]|\\[[0-9A-Fa-f:.]+\\])?(:([0-9]+))?/([^\\?#]*)(\\?([^#]*))?(#(.*))?$"),fY=c("^([Ff][Ii][Ll][Ee])://([^\\?#]*)(\\?([^#]*))?(#(.*))?$"),gL=c(bk),gN=c("multipart/form-data; boundary="),gO=c(bk),gP=[0,c(bk),[0,c("application/x-www-form-urlencoded")],bj],gQ=[0,c(bk),0,bj],gR=c("GET"),gM=c(a_),gG=c(b1),gH=c(b1),gI=c(dH),gC=c('"; filename="'),gD=c(dA),gA=c(bf),gB=c(bW),gE=c('"\r\n\r\n'),gF=c(dA),gy=c("--\r\n"),gz=c(bW),gx=c("js_of_ocaml-------------------"),gw=[0,c("xmlHttpRequest.ml"),79,2],gJ=c("XmlHttpRequest.Wrong_headers"),g9=c(dI),g_=c(dt),g8=c(b8),g$=c("YOU WIN !"),ha=c("YOU LOSE !"),hb=c(dk),hc=c("sprites/R.png"),hd=c("sprites/L.png"),he=c("sprites/U.png"),hf=c("sprites/D.png"),hg=c("sprites/push_r.png"),hh=c("sprites/bR.png"),hi=c("sprites/push_l.png"),hj=c("sprites/bL.png"),hA=c(b3),hy=c(b3),hz=c(b3),hq=c("%g"),hp=c(dE),hr=c("malformed level"),hn=c("border-collapse:collapse;line-height: 0; opacity: 0; margin-left:auto; margin-right:auto"),ho=c("padding: 0; width: 20px; height: 20px;"),hs=c("font-family: sans-serif; text-align: center; background-color: #e8e8e8;"),ht=c("Boulder Dash in Ocaml"),hu=c("Elapsed time: "),hv=c(" Remaining diamonds: "),hw=c(F),hx=c("Choose a level"),hk=[0,c("boulderdash.ml"),300,17],hl=c("boulderdash"),hm=c(bW),hB=c("maps.txt"),gZ=c("sprites/empty.png"),g0=c("sprites/grass.png"),g1=c("sprites/diamond.png"),g2=c(dt),g3=c("sprites/door.png"),g4=c(dk),g5=c(dI),g6=c("sprites/wall.png"),g7=c("sprites/bam.png"),gX=c("%02d:%02d:%02d"),gW=c("--:--:--"),gV=c("LOADING..."),gS=c("border: 1px black solid; background-color: white ; display: inline ; padding-right: .5em; padding-left: .5em;"),gT=c("background-color: red; color: white; display:inline; position: absolute; top:0; right:0;"),gY=c("Boulderdash.Death");function
+L(a){throw[0,at,a]}function
+Z(a){throw[0,bq,a]}function
+i(a,b){var
+c=a.getLen(),e=b.getLen(),d=Q(c+e|0);ad(a,0,d,0,c);ad(b,0,d,c,e);return d}function
+_(a){return c(d+a)}function
+cd(a,b){if(a){var
+c=a[1];return[0,c,cd(a[2],b)]}return b}h8(0);c_(1);var
+au=c_(2);function
+ce(a,b){return dV(a,b,0,b.getLen())}function
+cf(a){return ce(au,a)}function
+br(a){var
+b=h_(0);for(;;){if(b){var
+c=b[2],d=b[1];try{c$(d)}catch(f){}var
+b=c;continue}return 0}}da(d6,br);function
+d7(a,b){return db(a,b)}function
+cg(a){return c$(a)}function
+ch(a,b){var
+d=b.length-1;if(0===d)return[0];var
+e=R(d,j(a,b[0+1])),f=d-1|0,g=1;if(!(f<1)){var
+c=g;for(;;){e[c+1]=j(a,b[c+1]);var
+h=c+1|0;if(f!==c){var
+c=h;continue}break}}return e}function
+ci(a){if(a){var
+d=0,c=a,g=a[2],h=a[1];for(;;){if(c){var
+d=d+1|0,c=c[2];continue}var
+f=R(d,h),e=1,b=g;for(;;){if(b){var
+i=b[2];f[e+1]=b[1];var
+e=e+1|0,b=i;continue}return f}}}return[0]}function
+aj(a){var
+b=a,c=0;for(;;){if(b){var
+d=[0,b[1],c],b=b[2],c=d;continue}return c}}function
+$(a,b){if(b){var
+c=b[2],d=j(a,b[1]);return[0,d,$(a,c)]}return 0}function
+ak(a,b){var
+c=b;for(;;){if(c){var
+d=c[2];j(a,c[1]);var
+c=d;continue}return 0}}function
+av(a,b){var
+c=Q(a);hI(c,0,a,b);return c}function
+U(a,b,c){if(0<=b)if(0<=c)if(!((a.getLen()-c|0)'),w=v.tagName.toLowerCase()==="input"?1:0,B=w?v.name===ds?1:0:w,u=B}catch(f){var
+u=0}var
+z=u?dp:-1003883683;cW[1]=z;continue}if(dp<=s){var
+c=new
+bJ();c.push("<",dC);a2(q,function(a){c.push(' type="',dh(a),bc);return 0});a2(o,function(a){c.push(' name="',dh(a),bc);return 0});c.push(">");var
+b=f.createElement(c.join(d))}else{var
+i=bK(f,cY);a2(q,function(a){return i.type=a});a2(o,function(a){return i.name=a});var
+b=i}}var
+y=cX(f);P(y,hx);p(b,y);ak(function(a){var
+d=a[2],c=cX(f);P(c,d);return p(b,c)},m);b.onchange=E(function(a){var
+d=b.selectedIndex-1|0;if(0<=d){var
+i=0,g=m;for(;;){if(g){var
+i=i+1|0,g=g[2];continue}if(d
+
+
-
- Js_of_ocaml example: Boulderdash
-
-
-
-
-
+
+ Boulder Dash
+
+
+
+
+
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level0.map js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level0.map
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level0.map 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level0.map 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-###################
-#S........+.......#
-#+....+.........+##
-#...+........+.#.E#
-###################
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level1.map js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level1.map
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level1.map 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level1.map 1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-##################
-#S X # #
-# + #.X..XX....#
-# X #.+..++....#
-# + # + #
-# # XX #
-# . +. E#
-##################
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level2.map js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level2.map
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level2.map 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level2.map 1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-####################
-#S# XXXXX #
-# # XX .XXX. #
-# # .XX. .X. #
-# # +. + #
-# ## XX #
-# +X. E#
-####################
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level3.map js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level3.map
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level3.map 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level3.map 1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-##############
-#XXXX# #
-#XXX+# + #
-#X..S# X## #
-#+ +X+# #
-# #X#X# #
-# +E.... #
-# #++ #
-##############
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level4.map js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level4.map
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps/level4.map 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps/level4.map 1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-########################################
-#...... ..+.X .....X.X....... ....X....#
-#.XSX...... .........X+..X.... ..... ..#
-#.......... ..X.....X.X..X........X....#
-#X.XX.........X......X..X....X...X.....#
-#X. X......... X..X........X......X.XX.#
-#... ..X........X.....X. X........X.XX.#
-###############################...X..X.#
-#. ...X..+. ..X.X..........+.X+...... .#
-#..+.....X..... ........XX X..X....X...#
-#...X..X.X..............X .X..X........#
-#.X.....X........XXX.......X.. .+....X.#
-#.+.. ..X. .....X.X+..+....X...X..+. .#
-#. X..............X X..X........+.....X#
-#........###############################
-# X.........X...+....X.....X...X.......#
-# X......... X..X........X......X.XX..E#
-#. ..X........X.....X. ....+...X.XX...#
-#....X+..X........X......X.X+......X...#
-#... ..X. ..X.XX.........X.X+...... ..X#
-#.+.... ..... ......... .X..X....X...X.#
-########################################
diff -Nru js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps.txt js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps.txt
--- js-of-ocaml-1.4/doc/manual-aux/boulderdash/maps.txt 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/boulderdash/maps.txt 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-"maps/level0.map" "Level without boulders"
-"maps/level1.map" "Simple falls"
-"maps/level2.map" "More falls"
-"maps/level3.map" "Real (yet little) puzzle"
-"maps/level4.map" "Bigger puzzle (copie de BeeDeeDash)"
diff -Nru js-of-ocaml-1.4/doc/manual-aux/cubes/cubes.js js-of-ocaml-2.2/doc/manual-aux/cubes/cubes.js
--- js-of-ocaml-1.4/doc/manual-aux/cubes/cubes.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/cubes/cubes.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,989 @@
+// Generated by js_of_ocaml 2.0+git-03482cf
+(function(m){"use strict";var
+a2=125,a5=123,cf=254,B=255,b4="x",P=".",ce=108,as=65535,at="+",b6='"',u=16777215,b3="g",a0="f",aq=1073741823,b$=250,H=105,a$=0.5,b2="%d",b5="jsError",cc=-88,_=110,a1=2147483,ap="'",$=115,ao="int_of_string",b9=-32,a9=102,a7=111,a4=120,y=" ",Z="e",a3=117,G="-",O=-48,b8="nan",c="",aZ=116,b7="%.12g",au=100,a_=" : file already exists",p="0",a6="/",ar=114,a8=103,cd="fd ",cb=101,ca="index out of bounds",t="number",b_=1e3,av="src/core/lwt.ml";function
+cu(a,b){throw[0,a,b]}function
+be(a){if(a.charCodeAt(a.length-1)==10)a=a.substr(0,a.length-1);var
+b=m.console;b&&b.error&&b.error(a)}var
+e=[0];function
+ab(a,b){if(!a)return c;if(a&1)return ab(a-1,b)+b;var
+d=ab(a>>1,b);return d+d}function
+d(a){if(a!=null){this.bytes=this.fullBytes=a;this.last=this.len=a.length}}function
+cv(){cu(e[4],new
+d(ca))}d.prototype={string:null,bytes:null,fullBytes:null,array:null,len:null,last:0,toJsString:function(){var
+a=this.getFullBytes();try{return this.string=decodeURIComponent(escape(a))}catch(f){be('MlString.toJsString: wrong encoding for "%s" ',a);return a}},toBytes:function(){if(this.string!=null)try{var
+a=unescape(encodeURIComponent(this.string))}catch(f){be('MlString.toBytes: wrong encoding for "%s" ',this.string);var
+a=this.string}else{var
+a=c,d=this.array,e=d.length;for(var
+b=0;b=0;e--)b[c+e]=g[a+e];else{var
+f=this.bytes;if(f==null)f=this.toBytes();var
+h=this.last-a;if(d<=h)for(var
+e=0;e=this.len)cv();return this.get(a)},set:function(a,b){var
+c=this.array;if(!c){if(this.last==a){this.bytes+=String.fromCharCode(b&B);this.last++;return 0}c=this.toArray()}else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;c[a]=b&B;return 0},safeSet:function(a,b){if(this.len==null)this.toBytes();if(a<0||a>=this.len)cv();this.set(a,b)},fill:function(a,b,c){if(a>=this.last&&this.last&&c==0)return;var
+d=this.array;if(!d)d=this.toArray();else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;var
+f=a+b;for(var
+e=a;ea.string)return 1;return 0}var
+b=this.getFullBytes(),c=a.getFullBytes();if(bc)return 1;return 0},equal:function(a){if(this.string!=null&&a.string!=null)return this.string==a.string;return this.getFullBytes()==a.getFullBytes()},lessThan:function(a){if(this.string!=null&&a.string!=null)return this.string=a.length-1)ci();return a[b+1]}function
+ec(a,b,c){if(b<0||b>=a.length-1)ci();a[b+1]=c;return 0}function
+cj(a,b,c,d,e){if(e===0)return;if(d===c.last&&c.bytes!=null){var
+f=a.bytes;if(f==null)f=a.toBytes();if(b>0||a.last>e)f=f.slice(b,b+e);c.bytes+=f;c.last+=f.length;return}var
+g=c.array;if(!g)g=c.toArray();else
+c.bytes=c.string=null;a.blitToArray(b,g,d,e)}function
+C(c,b){if(c.fun)return C(c.fun,b);var
+a=c.length,d=a-b.length;if(d==0)return c.apply(null,b);else
+if(d<0)return C(c.apply(null,b.slice(0,a)),b.slice(a));else
+return function(a){return C(c,b.concat([a]))}}function
+ed(a){if(isFinite(a)){if(Math.abs(a)>=2.22507385850720138e-308)return 0;if(a!=0)return 1;return 2}return isNaN(a)?4:3}function
+ee(){return 0}function
+cg(a){this.bytes=c;this.len=a}cg.prototype=new
+d();function
+cl(a){if(a<0)Q("String.create");return new
+cg(a)}function
+aw(a){bd(e[3],a)}function
+eg(a,b,c,d){a.fill(b,c,d)}function
+bc(a){a=a.toString();var
+e=a.length;if(e>31)Q("format_int: format too long");var
+b={justify:at,signstyle:G,filler:y,alternate:false,base:0,signedconv:false,width:0,uppercase:false,sign:1,prec:-1,conv:a0};for(var
+d=0;d=0&&c<=9){b.width=b.width*10+c;d++}d--;break;case
+P:b.prec=0;d++;while(c=a.charCodeAt(d)-48,c>=0&&c<=9){b.prec=b.prec*10+c;d++}d--;case"d":case"i":b.signedconv=true;case"u":b.base=10;break;case
+b4:b.base=16;break;case"X":b.base=16;b.uppercase=true;break;case"o":b.base=8;break;case
+Z:case
+a0:case
+b3:b.signedconv=true;b.conv=c;break;case"E":case"F":case"G":b.signedconv=true;b.uppercase=true;b.conv=c.toLowerCase();break}}return b}function
+ba(a,b){if(a.uppercase)b=b.toUpperCase();var
+f=b.length;if(a.signedconv&&(a.sign<0||a.signstyle!=G))f++;if(a.alternate){if(a.base==8)f+=1;if(a.base==16)f+=2}var
+d=c;if(a.justify==at&&a.filler==y)for(var
+e=f;ee){var
+d=i-1;while(c.charAt(d)==p)d--;if(c.charAt(d)==P)d--;c=c.slice(0,d+1)+c.slice(i);d=c.length;if(c.charAt(d-3)==Z)c=c.slice(0,d-1)+p+c.slice(d-1);break}else{var
+g=e;if(h<0){g-=h+1;c=b.toFixed(g)}else
+while(c=b.toFixed(g),c.length>e+1)g--;if(g){var
+d=c.length-1;while(c.charAt(d)==p)d--;if(c.charAt(d)==P)d--;c=c.slice(0,d+1)}}break}return ba(f,c)}function
+ei(a,b){if(a.toString()==b2)return new
+J(c+b);var
+d=bc(a);if(b<0)if(d.signedconv){d.sign=-1;b=-b}else
+b>>>=0;var
+e=b.toString(d.base);if(d.prec>=0){d.filler=y;var
+f=d.prec-e.length;if(f>0)e=ab(f,p)+e}return ba(d,e)}function
+ek(){return 0}function
+em(a,b){var
+c=a[3]<<16,d=b[3]<<16;if(c>d)return 1;if(cb[2])return 1;if(a[2]b[1])return 1;if(a[1]1)f.push(a,b,1)}}else
+return 1}else
+if(b
+instanceof
+d||b
+instanceof
+Array&&b[0]===(b[0]|0))return-1;else
+if(typeof
+a!=t&&a&&a.compare)return a.compare(b,c);else{if(ab)return 1;if(a!=b){if(!c)return NaN;if(a==a)return 1;if(b==b)return-1}}if(f.length==0)return 0;var
+i=f.pop();b=f.pop();a=f.pop();if(i+1=0)}function
+ep(a){return(a[3]|a[2]|a[1])==0}function
+es(a){return[B,a&u,a>>24&u,a>>31&as]}function
+et(a,b){var
+c=a[1]-b[1],d=a[2]-b[2]+(c>>24),e=a[3]-b[3]+(d>>24);return[B,c&u,d&u,e&as]}function
+cn(a,b){if(a[3]>b[3])return 1;if(a[3]b[2])return 1;if(a[2]b[1])return 1;if(a[1]>23;a[2]=(a[2]<<1|a[1]>>23)&u;a[1]=a[1]<<1&u}function
+eq(a){a[1]=(a[1]>>>1|a[2]<<23)&u;a[2]=(a[2]>>>1|a[3]<<23)&u;a[3]=a[3]>>>1}function
+ev(a,b){var
+e=0,d=a.slice(),c=b.slice(),f=[B,0,0,0];while(cn(d,c)>0){e++;cm(c)}while(e>=0){e--;cm(f);if(cn(d,c)>=0){f[1]++;d=et(d,c)}eq(c)}return[0,f,d]}function
+eu(a){return a[1]|a[2]<<24}function
+eo(a){return a[3]<<16<0}function
+er(a){var
+b=-a[1],c=-a[2]+(b>>24),d=-a[3]+(c>>24);return[B,b&u,c&u,d&as]}function
+en(a,b){var
+d=bc(a);if(d.signedconv&&eo(b)){d.sign=-1;b=er(b)}var
+e=c,i=es(d.base),h="0123456789abcdef";do{var
+g=ev(b,i);b=g[1];e=h.charAt(eu(g[2]))+e}while(!ep(b));if(d.prec>=0){d.filler=y;var
+f=d.prec-e.length;if(f>0)e=ab(f,p)+e}return ba(d,e)}function
+eN(a){var
+b=0,c=10,d=a.get(0)==45?(b++,-1):1;if(a.get(b)==48)switch(a.get(b+1)){case
+a4:case
+88:c=16;b+=2;break;case
+a7:case
+79:c=8;b+=2;break;case
+98:case
+66:c=2;b+=2;break}return[b,d,c]}function
+cs(a){if(a>=48&&a<=57)return a-48;if(a>=65&&a<=90)return a-55;if(a>=97&&a<=122)return a-87;return-1}function
+ex(a){var
+g=eN(a),f=g[0],h=g[1],d=g[2],i=-1>>>0,e=a.get(f),c=cs(e);if(c<0||c>=d)aw(ao);var
+b=c;for(;;){f++;e=a.get(f);if(e==95)continue;c=cs(e);if(c<0||c>=d)break;b=d*b+c;if(b>i)aw(ao)}if(f!=a.getLen())aw(ao);b=h*b;if(d==10&&(b|0)!=b)aw(ao);return b|0}function
+ey(a){return+(a>31&&a<127)}function
+ez(){var
+b=m.console?m.console:{},c=["log","debug","info","warn","error","assert","dir","dirxml","trace","group","groupCollapsed","groupEnd","time","timeEnd"];function
+d(){}for(var
+a=0;a0?c.call(arguments):[undefined];return C(a,b)}}function
+eB(a,b){var
+d=[0];for(var
+c=1;c<=a;c++)d[c]=b;return d}function
+ch(a){var
+b=a.length;this.array=a;this.len=this.last=b}ch.prototype=new
+d();var
+eC=function(){function
+m(a,b){return a+b|0}function
+l(a,b,c,d,e,f){b=m(m(b,a),m(d,f));return m(b<>>32-e,c)}function
+h(a,b,c,d,e,f,g){return l(b&c|~b&d,a,b,e,f,g)}function
+i(a,b,c,d,e,f,g){return l(b&d|c&~d,a,b,e,f,g)}function
+j(a,b,c,d,e,f,g){return l(b^c^d,a,b,e,f,g)}function
+k(a,b,c,d,e,f,g){return l(c^(b|~d),a,b,e,f,g)}function
+n(a,b){var
+g=b;a[g>>2]|=128<<8*(g&3);for(g=(g&~3)+8;(g&63)<60;g+=4)a[(g>>2)-1]=0;a[(g>>2)-1]=b<<3;a[g>>2]=b>>29&536870911;var
+l=[1732584193,4023233417,2562383102,271733878];for(g=0;g>8*n&B;return o}return function(a,b,c){var
+h=[];if(a.array){var
+f=a.array;for(var
+d=0;d>2]=f[e]|f[e+1]<<8|f[e+2]<<16|f[e+3]<<24}for(;d>2]|=f[d+b]<<8*(d&3)}else{var
+g=a.getFullBytes();for(var
+d=0;d>2]=g.charCodeAt(e)|g.charCodeAt(e+1)<<8|g.charCodeAt(e+2)<<16|g.charCodeAt(e+3)<<24}for(;d>2]|=g.charCodeAt(d+b)<<8*(d&3)}return new
+ch(n(h,c))}}();function
+q(a){bd(e[2],a)}function
+co(a){if(!a.opened)q("Cannot flush a closed channel");if(a.buffer==c)return 0;if(a.output)switch(a.output.length){case
+2:a.output(a,a.buffer);break;default:a.output(a.buffer)}a.buffer=c}function
+ct(a){a=a
+instanceof
+d?a.toString():a;q(a+": No such file or directory")}var
+ef=a6;function
+ax(a){a=a
+instanceof
+d?a.toString():a;if(a.charCodeAt(0)!=47)a=ef+a;var
+f=a.split(a6),b=[];for(var
+e=0;e1)b.pop();break;case
+P:case
+c:if(b.length==0)b.push(c);break;default:b.push(f[e]);break}b.orig=a;return b}function
+I(){this.content={}}I.prototype={exists:function(a){return this.content[a]?1:0},mk:function(a,b){this.content[a]=b},get:function(a){return this.content[a]},list:function(){var
+a=[];for(var
+b
+in
+this.content)a.push(b);return a},remove:function(a){delete
+this.content[a]}};var
+az=new
+I();az.mk(c,new
+I());function
+bb(a){var
+b=az;for(var
+c=0;c>16)*b<<16)+(a&as)*b|0};var
+eI=Math.imul;function
+eK(a,b){return+(ck(a,b,false)!=0)}function
+eL(a){return+(a
+instanceof
+Array)}function
+eM(a){return a
+instanceof
+Array?a[0]:b_}function
+eQ(a,b){e[a+1]=b}var
+cq={};function
+eR(a,b){cq[a.toString()]=b;return 0}function
+eT(){return 32}function
+eU(a){if(m.quit)m.quit(a);Q("Function 'exit' not implemented")}function
+eX(){var
+a=new
+Date()^4294967295*Math.random();return{valueOf:function(){return a},0:0,1:a,length:2}}function
+eY(a){var
+b=1;while(a&&a.joo_tramp){a=a.joo_tramp.apply(null,a.joo_args);b++}return a}function
+eZ(a,b){return{joo_tramp:a,joo_args:b}}function
+e0(a,b){if(typeof
+b==="function"){a.fun=b;return 0}if(b.fun){a.fun=b.fun;return 0}var
+c=b.length;while(c--)a[c]=b[c];return 0}function
+eJ(a){return cq[a]}function
+e1(a){if(a
+instanceof
+Array)return a;if(m.RangeError&&a
+instanceof
+m.RangeError&&a.message&&a.message.match(/maximum call stack/i))return[0,e[9]];if(m.InternalError&&a
+instanceof
+m.InternalError&&a.message&&a.message.match(/too much recursion/i))return[0,e[9]];if(a
+instanceof
+m.Error)return[0,eJ(b5),a];return[0,e[3],new
+J(String(a))]}var
+i=eb,h=ec,ak=cj,A=cl,aT=eh,al=ei,aU=ey,aY=eA,v=eB,bX=co,bW=eE,bZ=eG,b1=eH,b=cr,b0=eM,a=eQ,bY=eR,an=eY,x=eZ,aV=e1;function
+j(a,b){return a.length==1?a(b):C(a,[b])}function
+n(a,b,c){return a.length==2?a(b,c):C(a,[b,c])}function
+l(a,b,c,d){return a.length==3?a(b,c,d):C(a,[b,c,d])}function
+am(a,b,c,d,e,f){return a.length==5?a(b,c,d,e,f):C(a,[b,c,d,e,f])}var
+aB=[0,b("Failure")],bf=[0,b("Invalid_argument")],bA=[0,b("Match_failure")],bz=[0,b("Stack_overflow")],L=[0,b("Assert_failure")],bB=[0,b("Undefined_recursive_module")],aJ=b('File "%s", line %d, characters %d-%d: %s');a(11,bB);a(8,bz);a(7,bA);a(6,[0,b("Not_found")]);a(5,[0,b("Division_by_zero")]);a(4,[0,b("End_of_file")]);a(3,bf);a(2,aB);a(1,[0,b("Sys_error")]);var
+dh=[0,b("Out_of_memory")],cz=b(b7),cy=b(P),cw=b("true"),cx=b("false"),cA=b("Pervasives.do_at_exit"),cE=b("\\b"),cF=b("\\t"),cG=b("\\n"),cH=b("\\r"),cD=b("\\\\"),cC=b("\\'"),cJ=b("String.blit"),cI=b("String.sub"),cK=b("Queue.Empty"),cM=b("Buffer.add: cannot grow buffer"),c2=b(c),c3=b(c),c6=b(b7),c7=b(b6),c8=b(b6),c4=b(ap),c5=b(ap),c1=b(b8),cZ=b("neg_infinity"),c0=b("infinity"),cY=b(P),cX=b("printf: bad positional specification (0)."),cW=b("%_"),cV=[0,b("printf.ml"),143,8],cT=b(ap),cU=b("Printf: premature end of format string '"),cP=b(ap),cQ=b(" in format string '"),cR=b(", at char number "),cS=b("Printf: bad conversion %"),cN=b("Sformat.index_of_int: negative argument "),db=b(c),dc=b(", %s%s"),du=[1,1],dv=b("%s\n"),dw=b("(Program not linked with -g, cannot print stack backtrace)\n"),dn=b("Raised at"),dr=b("Re-raised at"),ds=b("Raised by primitive operation at"),dt=b("Called from"),dp=b('%s file "%s", line %d, characters %d-%d'),dq=b("%s unknown location"),di=b("Out of memory"),dj=b("Stack overflow"),dk=b("Pattern matching failed"),dl=b("Assertion failed"),dm=b("Undefined recursive module"),dd=b("(%s%s)"),de=b(c),df=b(c),dg=b("(%s)"),da=b(b2),c_=b("%S"),c$=b("_"),dF=b("Random.int"),dy=b(b4),dG=[0,987910699,495797812,364182224,414272206,318284740,990407751,383018966,270373319,840823159,24560019,536292337,512266505,189156120,730249596,143776328,51606627,140166561,366354223,1003410265,700563762,981890670,913149062,526082594,1021425055,784300257,667753350,630144451,949649812,48546892,415514493,258888527,511570777,89983870,283659902,308386020,242688715,482270760,865188196,1027664170,207196989,193777847,619708188,671350186,149669678,257044018,87658204,558145612,183450813,28133145,901332182,710253903,510646120,652377910,409934019,801085050],dO=[0,b(av),648,20],dP=[0,b(av),651,8],dN=[0,b(av),498,8],dM=[0,b(av),487,9],dL=b("Lwt.wakeup_result"),dI=b("Fatal error: exception "),dH=b("Lwt.Canceled"),dX=b("Js.Error"),dY=b(b5),dZ=b("Dom_html.Canvas_not_available"),d3=b("Exception during Lwt.async: ");function
+aA(a){throw[0,aB,a]}function
+K(a){throw[0,bf,a]}function
+k(a,b){var
+c=a.getLen(),e=b.getLen(),d=A(c+e|0);ak(a,0,d,0,c);ak(b,0,d,c,e);return d}function
+ad(a){return b(c+a)}eD(0);bW(1);var
+R=bW(2);function
+bg(a,b){return cp(a,b,0,b.getLen())}function
+bh(a){return bg(R,a)}function
+aC(a){var
+b=eF(0);for(;;){if(b){var
+c=b[2],d=b[1];try{bX(d)}catch(f){}var
+b=c;continue}return 0}}bY(cA,aC);function
+cB(a,b){return bZ(a,b)}function
+bi(a){return bX(a)}function
+bj(a,b){if(0===a)return[0];var
+d=v(a,j(b,0)),e=a-1|0,f=1;if(!(e<1)){var
+c=f;for(;;){d[c+1]=j(b,c);var
+g=c+1|0;if(e!==c){var
+c=g;continue}break}}return d}function
+ae(a,b){var
+c=A(a);eg(c,0,a,b);return c}function
+af(a,b,c){if(0<=b)if(0<=c)if(!((a.getLen()-c|0)>>25&31)|0)&aq;h(g[1],g[2],b);var
+d=b1(b,a);if(((aq-a|0)+1|0)<(b-d|0))continue;return d}return K(dF)}function
+bJ(a){var
+b=[];e0(b,[0,b,b]);return b}var
+aO=[0,dH],E=[0,0];function
+aP(a){var
+c=a[1];if(3===c[0]){var
+d=c[1],b=aP(d);if(b!==d)a[1]=[3,b];return b}return a}function
+X(a){return aP(a)}var
+bK=[0,function(a){bh(dI);bh(by(a));bZ(R,10);bC(R);bi(R);aC(0);return eU(2)}];function
+bL(a,b){try{var
+c=j(a,b)}catch(f){f=aV(f);return j(bK[1],f)}return c}function
+aW(a,b,c,d){var
+f=c,e=d;for(;;)if(typeof
+f===t)return a<50?w(1+a,b,e):x(w,[0,b,e]);else
+switch(f[0]){case
+1:j(f[1],b);return a<50?w(1+a,b,e):x(w,[0,b,e]);case
+2:var
+h=[0,f[2],e],f=f[1],e=h;continue;default:var
+g=f[1][1];if(g){j(g[1],b);return a<50?w(1+a,b,e):x(w,[0,b,e])}else
+return a<50?w(1+a,b,e):x(w,[0,b,e])}}function
+w(a,b,c){return c?a<50?aW(1+a,b,c[1],c[2]):x(aW,[0,b,c[1],c[2]]):0}function
+dJ(b,c,d){return an(aW(0,b,c,d))}function
+e3(b,c){return an(w(0,b,c))}function
+aX(a,b,c){var
+e=b,d=c;for(;;)if(typeof
+e===t)return a<50?F(1+a,d):x(F,[0,d]);else
+switch(e[0]){case
+1:var
+f=e[1];if(f[4]){f[4]=0;f[1][2]=f[2];f[2][1]=f[1]}return a<50?F(1+a,d):x(F,[0,d]);case
+2:var
+h=[0,e[2],d],e=e[1],d=h;continue;default:var
+g=e[2];E[1]=e[1];bL(g,0);return a<50?F(1+a,d):x(F,[0,d])}}function
+F(a,b){return b?a<50?aX(1+a,b[1],b[2]):x(aX,[0,b[1],b[2]]):0}function
+dK(b,c){return an(aX(0,b,c))}function
+e4(b){return an(F(0,b))}function
+aj(a,b){var
+c=1===b[0]?b[1][1]===aO?(dK(a[4],0),1):0:0;return dJ(b,a[2],0)}var
+aQ=[0,0],M=[0,0,0];function
+bM(a,b){var
+h=[0,b],i=aP(a),e=i[1];switch(e[0]){case
+1:if(e[1][1]===aO)return 0;break;case
+2:var
+k=e[1];i[1]=h;var
+g=E[1],j=aQ[1]?1:(aQ[1]=1,0);aj(k,h);if(j){E[1]=g;return 0}for(;;){if(0===M[1]){aQ[1]=0;E[1]=g;return 0}if(0===M[1])throw[0,cL];M[1]=M[1]-1|0;var
+c=M[2],d=c[2];if(d===c)M[2]=0;else
+c[2]=d[2];var
+f=d[1];aj(f[1],f[2]);continue}}return K(dL)}function
+bN(a,b){return typeof
+a===t?b:typeof
+b===t?a:[2,a,b]}function
+aR(a){if(typeof
+a!==t)switch(a[0]){case
+2:var
+b=a[1],c=aR(a[2]);return bN(aR(b),c);case
+1:break;default:if(!a[1][1])return 0}return a}var
+dQ=[0,function(a){return 0}],s=bJ(0),dR=[0,0],z=m;function
+dS(a){var
+e=1-(s[2]===s?1:0);if(e){var
+b=bJ(0);b[1][2]=s[2];s[2][1]=b[1];b[1]=s[1];s[1][2]=b;s[1]=s;s[2]=s;dR[1]=0;var
+c=b[2];for(;;){var
+d=c!==b?1:0;if(d){if(c[4])bM(c[3],0);var
+c=c[2];continue}return d}}return e}var
+bO=[0,dX],dW=z.Array;bY(dY,[0,bO,{}][0+1]);var
+dT=null,dU=undefined,dV=false;bD(function(a){return a[1]===bO?[0,new
+J(a[2].toString())]:0});bD(function(a){return a
+instanceof
+dW?0:[0,new
+J(a.toString())]});var
+bP="2d",d0=[0,dZ];z.HTMLElement===dU;var
+d1=ez(0),d2=a1;dQ[1]=function(a){return 1===a?(z.setTimeout(aY(dS),0),0):0};function
+bQ(a){return d1.log(a.toString())}bK[1]=function(a){bQ(d3);bQ(by(a));return bC(R)};var
+f=Math.floor(20*1.73205080756887719/2+a$),bI=eX(0),Y=12,bF=0===bI.length-1?[0,0]:bI,aL=bF.length-1,dx=0;if(!0){var
+W=dx;for(;;){h(g[1],W,W);var
+dE=W+1|0;if(54!==W){var
+W=dE;continue}break}}var
+aM=[0,dy],dz=0,dA=55,dB=el(55,aL)?dA:aL,bG=54+dB|0;if(!(bG<0)){var
+V=dz;for(;;){var
+bH=V%55|0,dC=aM[1],bE=k(dC,ad(i(bF,b1(V,aL))));aM[1]=eC(bE,0,bE.getLen());var
+ai=aM[1];h(g[1],bH,(i(g[1],bH)^(((ai.safeGet(0)+(ai.safeGet(1)<<8)|0)+(ai.safeGet(2)<<16)|0)+(ai.safeGet(3)<<24)|0))&aq);var
+dD=V+1|0;if(bG!==V){var
+V=dD;continue}break}}g[2]=0;function
+N(a,b,c,d){var
+f=b<0?1:0;if(f)var
+e=f;else{var
+g=c<0?1:0;if(g)var
+e=g;else{var
+h=d<0?1:0;if(h)var
+e=h;else{var
+j=b<12?1:0;if(j){var
+k=c<12?1:0;if(k)var
+l=d<12?1:0,e=l?i(i(i(a,b),c),d):l;else
+var
+e=k}else
+var
+e=j}}}return e}var
+d4="#a8a8f6",d5="#d9d9d9",d6="#767676";function
+aS(a,b,c,d,e){a.save();a.translate((((b-d|0)+12|0)-1|0)*f,(11-c|0)*20+(b+d|0)*20/2);j(e,a);return a.restore()}function
+d7(a){a.fillStyle=d4;a.beginPath();a.moveTo(f,0);a.lineTo(2*f,10);a.lineTo(f,20);a.lineTo(0,10);return a.fill()}function
+d8(a){a.beginPath();a.moveTo(0,10);a.lineTo(f,0);a.lineTo(2*f,10);return a.stroke()}function
+d9(a){a.fillStyle=d6;a.beginPath();a.moveTo(f,20);a.lineTo(f,40);a.lineTo(2*f,30);a.lineTo(2*f,10);return a.fill()}function
+d_(a){a.beginPath();a.moveTo(f,40);a.lineTo(f,20);a.lineTo(2*f,10);return a.stroke()}function
+d$(a){a.fillStyle=d5;a.beginPath();a.moveTo(f,20);a.lineTo(f,40);a.lineTo(0,30);a.lineTo(0,10);return a.fill()}function
+ea(a){a.beginPath();a.moveTo(f,20);a.lineTo(0,10);a.lineTo(0,30);return a.stroke()}function
+bR(a,b,c){var
+n=c[3],o=c[2],p=c[1],q=0,r=11;if(!(11<0)){var
+h=q;for(;;){var
+m=[0,11],E=0,F=11;if(!(11<0)){var
+j=E;c:for(;;){for(;;){if(0<=m[1])if(!i(i(i(b,h),m[1]),j)){m[1]+=-1;continue}aS(a,h,m[1],j,p);var
+H=j+1|0;if(F!==j){var
+j=H;continue c}break}break}}var
+G=h+1|0;if(r!==h){var
+h=G;continue}break}}var
+s=0,t=11;if(!(11<0)){var
+f=s;for(;;){var
+l=[0,11],A=0,B=11;if(!(11<0)){var
+g=A;c:for(;;){for(;;){if(0<=l[1])if(!i(i(i(b,l[1]),f),g)){l[1]+=-1;continue}aS(a,l[1],f,g,o);var
+D=g+1|0;if(B!==g){var
+g=D;continue c}break}break}}var
+C=f+1|0;if(t!==f){var
+f=C;continue}break}}var
+u=0,v=11;if(!(11<0)){var
+d=u;for(;;){var
+k=[0,11],w=0,x=11;if(!(11<0)){var
+e=w;c:for(;;){for(;;){if(0<=k[1])if(!i(i(i(b,d),e),k[1])){k[1]+=-1;continue}aS(a,d,e,k[1],n);var
+z=e+1|0;if(x!==e){var
+e=z;continue c}break}break}}var
+y=d+1|0;if(v!==d){var
+d=y;continue}break}}return 0}function
+bS(a){var
+b=z.document.createElement("canvas");if(1-(b.getContext==dT?1:0)){b.width=(24*(f|0)|0)+1|0;b.height=(24*20|0)+1|0;return b}throw[0,d0]}function
+bT(a,b,c){var
+d=b.getContext(bP);d.setTransform(1,0,0,1,0,0);d.clearRect(0,0,b.width,b.height);d.setTransform(1,0,0,1,a$,a$);d.globalCompositeOperation="lighter";bR(d,c,[0,d7,d9,d$]);d.globalCompositeOperation="source-over";bR(d,c,[0,d8,d_,ea]);d.beginPath();d.moveTo(0,18*20);d.lineTo(12*f,24*20);d.lineTo(24*f,18*20);d.lineTo(24*f,6*20);d.stroke();return a.drawImage(b,0,0)}function
+bU(s,b,c){function
+u(a){var
+l=[0,0],n=0;if(!0){var
+m=n;for(;;){var
+d=aN(Y),e=aN(Y),f=aN(Y);if(i(i(i(c,d),e),f)){if(N(c,d+1|0,e,f))var
+j=0;else
+if(N(c,d,e+1|0,f))var
+j=0;else
+if(N(c,d,e,f+1|0))var
+j=0;else{h(i(i(c,d),e),f,0);var
+g=1,j=1}if(!j)var
+g=0}else{if(N(c,d-1|0,e,f))if(N(c,d,e-1|0,f))if(N(c,d,e,f-1|0)){h(i(i(c,d),e),f,1);var
+g=1,k=1}else
+var
+k=0;else
+var
+k=0;else
+var
+k=0;if(!k)var
+g=0}var
+o=g||l[1];l[1]=o;var
+p=m+1|0;if(99!==m){var
+m=p;continue}break}}if(l[1])bT(s,b,c);return bU(s,b,c)}var
+d=[0,[2,[0,1,0,0,0]]],p=[0,0],A=0.2;function
+q(a,b){var
+c=a1
+
+
+
+ Cubes
+
+
+
+
+
diff -Nru js-of-ocaml-1.4/doc/manual-aux/graph/index.html js-of-ocaml-2.2/doc/manual-aux/graph/index.html
--- js-of-ocaml-1.4/doc/manual-aux/graph/index.html 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/graph/index.html 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-
-
-
-
- Graph viewer
-
-
-
-
-
diff -Nru js-of-ocaml-1.4/doc/manual-aux/graph/jsviewer.js js-of-ocaml-2.2/doc/manual-aux/graph/jsviewer.js
--- js-of-ocaml-1.4/doc/manual-aux/graph/jsviewer.js 2013-12-03 11:10:26.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/graph/jsviewer.js 1970-01-01 00:00:00.000000000 +0000
@@ -1,747 +0,0 @@
-// This program was compiled from OCaml by js_of_ocaml 1.0
-function caml_raise_with_arg (tag, arg) { throw [0, tag, arg]; }
-function caml_raise_with_string (tag, msg) {
- caml_raise_with_arg (tag, new MlWrappedString (msg));
-}
-function caml_invalid_argument (msg) {
- caml_raise_with_string(caml_global_data[4], msg);
-}
-function caml_array_bound_error () {
- caml_invalid_argument("index out of bounds");
-}
-function caml_str_repeat(n, s) {
- if (!n) { return ""; }
- if (n & 1) { return caml_str_repeat(n - 1, s) + s; }
- var r = caml_str_repeat(n >> 1, s);
- return r + r;
-}
-function MlString(param) {
- if (param != null) {
- this.bytes = this.fullBytes = param;
- this.last = this.len = param.length;
- }
-}
-MlString.prototype = {
- string:null,
- bytes:null,
- fullBytes:null,
- array:null,
- len:null,
- last:0,
- toJsString:function() {
- return this.string = decodeURIComponent (escape(this.getFullBytes()));
- },
- toBytes:function() {
- if (this.string != null)
- var b = unescape (encodeURIComponent (this.string));
- else {
- var b = "", a = this.array, l = a.length;
- for (var i = 0; i < l; i ++) b += String.fromCharCode (a[i]);
- }
- this.bytes = this.fullBytes = b;
- this.last = this.len = b.length;
- return b;
- },
- getBytes:function() {
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- return b;
- },
- getFullBytes:function() {
- var b = this.fullBytes;
- if (b !== null) return b;
- b = this.bytes;
- if (b == null) b = this.toBytes ();
- if (this.last < this.len) {
- this.bytes = (b += caml_str_repeat(this.len - this.last, '\0'));
- this.last = this.len;
- }
- this.fullBytes = b;
- return b;
- },
- toArray:function() {
- var b = this.bytes;
- if (b == null) b = this.toBytes ();
- var a = [], l = this.last;
- for (var i = 0; i < l; i++) a[i] = b.charCodeAt(i);
- for (l = this.len; i < l; i++) a[i] = 0;
- this.string = this.bytes = this.fullBytes = null;
- this.last = this.len;
- this.array = a;
- return a;
- },
- getArray:function() {
- var a = this.array;
- if (!a) a = this.toArray();
- return a;
- },
- getLen:function() {
- var len = this.len;
- if (len !== null) return len;
- this.toBytes();
- return this.len;
- },
- toString:function() { var s = this.string; return s?s:this.toJsString(); },
- valueOf:function() { var s = this.string; return s?s:this.toJsString(); },
- blitToArray:function(i1, a2, i2, l) {
- var a1 = this.array;
- if (a1)
- for (var i = 0; i < l; i++) a2 [i2 + i] = a1 [i1 + i];
- else {
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- var l1 = this.last - i1;
- if (l <= l1)
- for (var i = 0; i < l; i++) a2 [i2 + i] = b.charCodeAt(i1 + i);
- else {
- for (var i = 0; i < l1; i++) a2 [i2 + i] = b.charCodeAt(i1 + i);
- for (; i < l; i++) a2 [i2 + i] = 0;
- }
- }
- },
- get:function (i) {
- var a = this.array;
- if (a) return a[i];
- var b = this.bytes;
- if (b == null) b = this.toBytes();
- return (i= this.len)) caml_array_bound_error ();
- return this.get(i);
- },
- set:function (i, c) {
- var a = this.array;
- if (!a) {
- if (this.last == i) {
- this.bytes += String.fromCharCode (c & 0xff);
- this.last ++;
- return 0;
- }
- a = this.toArray();
- } else if (this.bytes != null) {
- this.bytes = this.fullBytes = this.string = null;
- }
- a[i] = c & 0xff;
- return 0;
- },
- safeSet:function (i, c) {
- if (this.len == null) this.toBytes ();
- if ((i < 0) || (i >= this.len)) caml_array_bound_error ();
- this.set(i, c);
- },
- fill:function (ofs, len, c) {
- if (ofs >= this.last && this.last && c == 0) return;
- var a = this.array;
- if (!a) a = this.toArray();
- else if (this.bytes != null) {
- this.bytes = this.fullBytes = this.string = null;
- }
- var l = ofs + len;
- for (var i = ofs; i < l; i++) a[i] = c;
- },
- compare:function (s2) {
- if (this.string != null && s2.string != null) {
- if (this.string < s2.string) return -1;
- if (this.string > s2.string) return 1;
- return 0;
- }
- var b1 = this.getFullBytes ();
- var b2 = s2.getFullBytes ();
- if (b1 < b2) return -1;
- if (b1 > b2) return 1;
- return 0;
- },
- equal:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string == s2.string;
- return this.getFullBytes () == s2.getFullBytes ();
- },
- lessThan:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string < s2.string;
- return this.getFullBytes () < s2.getFullBytes ();
- },
- lessEqual:function (s2) {
- if (this.string != null && s2.string != null)
- return this.string <= s2.string;
- return this.getFullBytes () <= s2.getFullBytes ();
- }
-}
-function MlWrappedString (s) { this.string = s; }
-MlWrappedString.prototype = new MlString();
-function MlMakeString (l) { this.bytes = ""; this.len = l; }
-MlMakeString.prototype = new MlString ();
-function caml_array_get (array, index) {
- if ((index < 0) || (index >= array.length - 1)) caml_array_bound_error();
- return array[index+1];
-}
-function caml_array_set (array, index, newval) {
- if ((index < 0) || (index >= array.length - 1)) caml_array_bound_error();
- array[index+1]=newval; return 0;
-}
-function caml_blit_string(s1, i1, s2, i2, len) {
- if (len === 0) return;
- if (i2 === s2.last && s2.bytes != null) {
- var b = s1.bytes;
- if (b == null) b = s1.toBytes ();
- if (i1 > 0 || s1.last > len) b = b.slice(i1, i1 + len);
- s2.bytes += b;
- s2.last += b.length;
- return;
- }
- var a = s2.array;
- if (!a) a = s2.toArray(); else { s2.bytes = s2.string = null; }
- s1.blitToArray (i1, a, i2, len);
-}
-function caml_call_gen(f, args) {
- if(f.fun)
- return caml_call_gen(f.fun, args);
- var n = f.length;
- var d = n - args.length;
- if (d == 0)
- return f.apply(null, args);
- else if (d < 0)
- return caml_call_gen(f.apply(null, args.slice(0,n)), args.slice(n));
- else
- return function (x){ return caml_call_gen(f, args.concat([x])); };
-}
-function caml_classify_float (x) {
- if (isFinite (x)) {
- if (Math.abs(x) >= 2.2250738585072014e-308) return 0;
- if (x != 0) return 1;
- return 2;
- }
- return isNaN(x)?4:3;
-}
-function caml_int64_compare(x,y) {
- var x3 = x[3] << 16;
- var y3 = y[3] << 16;
- if (x3 > y3) return 1;
- if (x3 < y3) return -1;
- if (x[2] > y[2]) return 1;
- if (x[2] < y[2]) return -1;
- if (x[1] > y[1]) return 1;
- if (x[1] < y[1]) return -1;
- return 0;
-}
-function caml_int_compare (a, b) {
- if (a < b) return (-1); if (a == b) return 0; return 1;
-}
-function caml_compare_val (a, b, total) {
- var stack = [];
- for(;;) {
- if (!(total && a === b)) {
- if (a instanceof MlString) {
- if (b instanceof MlString) {
- if (a != b) {
- var x = a.compare(b);
- if (x != 0) return x;
- }
- } else
- return 1;
- } else if (a instanceof Array && a[0] === (a[0]|0)) {
- var ta = a[0];
- if (ta === 250) {
- a = a[1];
- continue;
- } else if (b instanceof Array && b[0] === (b[0]|0)) {
- var tb = b[0];
- if (tb === 250) {
- b = b[1];
- continue;
- } else if (ta != tb) {
- return (ta < tb)?-1:1;
- } else {
- switch (ta) {
- case 248: {
- var x = caml_int_compare(a[2], b[2]);
- if (x != 0) return x;
- break;
- }
- case 255: {
- var x = caml_int64_compare(a, b);
- if (x != 0) return x;
- break;
- }
- default:
- if (a.length != b.length) return (a.length < b.length)?-1:1;
- if (a.length > 1) stack.push(a, b, 1);
- }
- }
- } else
- return 1;
- } else if (b instanceof MlString ||
- (b instanceof Array && b[0] === (b[0]|0))) {
- return -1;
- } else {
- if (a < b) return -1;
- if (a > b) return 1;
- if (total && a != b) {
- if (a == a) return 1;
- if (b == b) return -1;
- }
- }
- }
- if (stack.length == 0) return 0;
- var i = stack.pop();
- b = stack.pop();
- a = stack.pop();
- if (i + 1 < a.length) stack.push(a, b, i + 1);
- a = a[i];
- b = b[i];
- }
-}
-function caml_compare (a, b) { return caml_compare_val (a, b, true); }
-function caml_create_string(len) {
- if (len < 0) caml_invalid_argument("String.create");
- return new MlMakeString(len);
-}
-function caml_raise_constant (tag) { throw [0, tag]; }
-var caml_global_data = [0];
-function caml_raise_zero_divide () {
- caml_raise_constant(caml_global_data[6]);
-}
-function caml_div(x,y) {
- if (y == 0) caml_raise_zero_divide ();
- return (x/y)|0;
-}
-function caml_equal (x, y) { return +(caml_compare_val(x,y,false) == 0); }
-function caml_fill_string(s, i, l, c) { s.fill (i, l, c); }
-function caml_parse_format (fmt) {
- fmt = fmt.toString ();
- var len = fmt.length;
- if (len > 31) caml_invalid_argument("format_int: format too long");
- var f =
- { justify:'+', signstyle:'-', filler:' ', alternate:false,
- base:0, signedconv:false, width:0, uppercase:false,
- sign:1, prec:6, conv:'f' };
- for (var i = 0; i < len; i++) {
- var c = fmt.charAt(i);
- switch (c) {
- case '-':
- f.justify = '-'; break;
- case '+': case ' ':
- f.signstyle = c; break;
- case '0':
- f.filler = '0'; break;
- case '#':
- f.alternate = true; break;
- case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9':
- f.width = 0;
- while (c=fmt.charCodeAt(i) - 48, c >= 0 && c <= 9) {
- f.width = f.width * 10 + c; i++
- }
- i--;
- break;
- case '.':
- f.prec = 0;
- i++;
- while (c=fmt.charCodeAt(i) - 48, c >= 0 && c <= 9) {
- f.prec = f.prec * 10 + c; i++
- }
- i--;
- case 'd': case 'i':
- f.signedconv = true; /* fallthrough */
- case 'u':
- f.base = 10; break;
- case 'x':
- f.base = 16; break;
- case 'X':
- f.base = 16; f.uppercase = true; break;
- case 'o':
- f.base = 8; break;
- case 'e': case 'f': case 'g':
- f.signedconv = true; f.conv = c; break;
- case 'E': case 'F': case 'G':
- f.signedconv = true; f.uppercase = true;
- f.conv = c.toLowerCase (); break;
- }
- }
- return f;
-}
-function caml_finish_formatting(f, rawbuffer) {
- if (f.uppercase) rawbuffer = rawbuffer.toUpperCase();
- var len = rawbuffer.length;
- if (f.signedconv && (f.sign < 0 || f.signstyle != '-')) len++;
- if (f.alternate) {
- if (f.base == 8) len += 1;
- if (f.base == 16) len += 2;
- }
- var buffer = "";
- if (f.justify == '+' && f.filler == ' ')
- for (var i = len; i < f.width; i++) buffer += ' ';
- if (f.signedconv) {
- if (f.sign < 0) buffer += '-';
- else if (f.signstyle != '-') buffer += f.signstyle;
- }
- if (f.alternate && f.base == 8) buffer += '0';
- if (f.alternate && f.base == 16) buffer += "0x";
- if (f.justify == '+' && f.filler == '0')
- for (var i = len; i < f.width; i++) buffer += '0';
- buffer += rawbuffer;
- if (f.justify == '-')
- for (var i = len; i < f.width; i++) buffer += ' ';
- return new MlWrappedString (buffer);
-}
-function caml_format_float (fmt, x) {
- var s, f = caml_parse_format(fmt);
- if (x < 0) { f.sign = -1; x = -x; }
- if (isNaN(x)) { s = "nan"; f.filler = ' '; }
- else if (!isFinite(x)) { s = "inf"; f.filler = ' '; }
- else
- switch (f.conv) {
- case 'e':
- var s = x.toExponential(f.prec);
- var i = s.length;
- if (s.charAt(i - 3) == 'e')
- s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
- break;
- case 'f':
- s = x.toFixed(f.prec); break;
- case 'g':
- var prec = f.prec?f.prec:1;
- s = x.toExponential(prec - 1);
- var j = s.indexOf('e');
- var exp = +s.slice(j + 1);
- if (exp < -4 || x.toFixed(0).length > prec) {
- var i = j - 1; while (s.charAt(i) == '0') i--;
- if (s.charAt(i) == '.') i--;
- s = s.slice(0, i + 1) + s.slice(j);
- i = s.length;
- if (s.charAt(i - 3) == 'e')
- s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
- break;
- } else {
- var p = prec;
- if (exp < 0) { p -= exp + 1; s = x.toFixed(p); }
- else while (s = x.toFixed(p), s.length > prec + 1) p--;
- if (p) {
- var i = s.length - 1; while (s.charAt(i) == '0') i--;
- if (s.charAt(i) == '.') i--;
- s = s.slice(0, i + 1);
- }
- }
- break;
- }
- return caml_finish_formatting(f, s);
-}
-function caml_format_int(fmt, i) {
- if (fmt.toString() == "%d") return new MlWrappedString(""+i);
- var f = caml_parse_format(fmt);
- if (i < 0) { if (f.signedconv) { f.sign = -1; i = -i; } else i >>>= 0; }
- var s = i.toString(f.base);
- return caml_finish_formatting(f, s);
-}
-function caml_get_public_method (obj, tag) {
- var meths = obj[1];
- var li = 3, hi = meths[1] * 2 + 1, mi;
- while (li < hi) {
- mi = ((li+hi) >> 1) | 1;
- if (tag < meths[mi+1]) hi = mi-2;
- else li = mi;
- }
- return (tag == meths[li+1] ? meths[li] : 0);
-}
-function caml_greaterequal (x, y) { return +(caml_compare(x,y,false) >= 0); }
-function caml_int64_is_negative(x) {
- return (x[3] << 16) < 0;
-}
-function caml_int64_neg (x) {
- var y1 = - x[1];
- var y2 = - x[2] + (y1 >> 24);
- var y3 = - x[3] + (y2 >> 24);
- return [255, y1 & 0xffffff, y2 & 0xffffff, y3 & 0xffff];
-}
-function caml_int64_of_int32 (x) {
- return [255, x & 0xffffff, (x >> 24) & 0xffffff, (x >> 31) & 0xffff]
-}
-function caml_int64_ucompare(x,y) {
- if (x[3] > y[3]) return 1;
- if (x[3] < y[3]) return -1;
- if (x[2] > y[2]) return 1;
- if (x[2] < y[2]) return -1;
- if (x[1] > y[1]) return 1;
- if (x[1] < y[1]) return -1;
- return 0;
-}
-function caml_int64_lsl1 (x) {
- x[3] = (x[3] << 1) | (x[2] >> 23);
- x[2] = ((x[2] << 1) | (x[1] >> 23)) & 0xffffff;
- x[1] = (x[1] << 1) & 0xffffff;
-}
-function caml_int64_lsr1 (x) {
- x[1] = ((x[1] >>> 1) | (x[2] << 23)) & 0xffffff;
- x[2] = ((x[2] >>> 1) | (x[3] << 23)) & 0xffffff;
- x[3] = x[3] >>> 1;
-}
-function caml_int64_sub (x, y) {
- var z1 = x[1] - y[1];
- var z2 = x[2] - y[2] + (z1 >> 24);
- var z3 = x[3] - y[3] + (z2 >> 24);
- return [255, z1 & 0xffffff, z2 & 0xffffff, z3 & 0xffff];
-}
-function caml_int64_udivmod (x, y) {
- var offset = 0;
- var modulus = x.slice ();
- var divisor = y.slice ();
- var quotient = [255, 0, 0, 0];
- while (caml_int64_ucompare (modulus, divisor) > 0) {
- offset++;
- caml_int64_lsl1 (divisor);
- }
- while (offset >= 0) {
- offset --;
- caml_int64_lsl1 (quotient);
- if (caml_int64_ucompare (modulus, divisor) >= 0) {
- quotient[1] ++;
- modulus = caml_int64_sub (modulus, divisor);
- }
- caml_int64_lsr1 (divisor);
- }
- return [0,quotient, modulus];
-}
-function caml_int64_to_int32 (x) {
- return x[1] | (x[2] << 24);
-}
-function caml_int64_is_zero(x) {
- return (x[3]|x[2]|x[1]) == 0;
-}
-function caml_int64_format (fmt, x) {
- var f = caml_parse_format(fmt);
- if (f.signedconv && caml_int64_is_negative(x)) {
- f.sign = -1; x = caml_int64_neg(x);
- }
- var buffer = "";
- var wbase = caml_int64_of_int32(f.base);
- var cvtbl = "0123456789abcdef";
- do {
- var p = caml_int64_udivmod(x, wbase);
- x = p[1];
- buffer = cvtbl.charAt(caml_int64_to_int32(p[2])) + buffer;
- } while (! caml_int64_is_zero(x));
- return caml_finish_formatting(f, buffer);
-}
-function caml_parse_sign_and_base (s) {
- var i = 0, base = 10, sign = s.get(0) == 45?(i++,-1):1;
- if (s.get(i) == 48)
- switch (s.get(i + 1)) {
- case 120: case 88: base = 16; i += 2; break;
- case 111: case 79: base = 8; i += 2; break;
- case 98: case 66: base = 2; i += 2; break;
- }
- return [i, sign, base];
-}
-function caml_parse_digit(c) {
- if (c >= 48 && c <= 57) return c - 48;
- if (c >= 65 && c <= 90) return c - 55;
- if (c >= 97 && c <= 122) return c - 87;
- return -1;
-}
-function caml_failwith (msg) {
- caml_raise_with_string(caml_global_data[3], msg);
-}
-function caml_int_of_string (s) {
- var r = caml_parse_sign_and_base (s);
- var i = r[0], sign = r[1], base = r[2];
- var threshold = -1 >>> 0;
- var c = s.get(i);
- var d = caml_parse_digit(c);
- if (d < 0 || d >= base) caml_failwith("int_of_string");
- var res = d;
- for (;;) {
- i++;
- c = s.get(i);
- if (c == 95) continue;
- d = caml_parse_digit(c);
- if (d < 0 || d >= base) break;
- res = base * res + d;
- if (res > threshold) caml_failwith("int_of_string");
- }
- if (i != s.getLen()) caml_failwith("int_of_string");
- res = sign * res;
- if ((res | 0) != res) caml_failwith("int_of_string");
- return res;
-}
-function caml_is_printable(c) { return +(c > 31 && c < 127); }
-function caml_js_call(f, o, args) { return f.apply(o, args.slice(1)); }
-function caml_js_from_byte_string (s) {return s.getFullBytes();}
-function caml_js_on_ie () {
- var ua = window.navigator?window.navigator.userAgent:"";
- return ua.indexOf("MSIE") != -1 && ua.indexOf("Opera") != 0;
-}
-function caml_js_to_byte_string (s) {return new MlString (s);}
-function caml_js_wrap_callback(f) {
- var toArray = Array.prototype.slice;
- return function () {
- var args = (arguments.length > 0)?toArray.call (arguments):[undefined];
- return caml_call_gen(f, args);
- }
-}
-function caml_lessequal (x, y) { return +(caml_compare(x,y,false) <= 0); }
-function caml_make_vect (len, init) {
- var b = [0]; for (var i = 1; i <= len; i++) b[i] = init; return b;
-}
-function MlStringFromArray (a) {
- var len = a.length; this.array = a; this.len = this.last = len;
-}
-MlStringFromArray.prototype = new MlString ();
-var caml_md5_string =
-function () {
- function add (x, y) { return (x + y) | 0; }
- function xx(q,a,b,x,s,t) {
- a = add(add(a, q), add(x, t));
- return add((a << s) | (a >>> (32 - s)), b);
- }
- function ff(a,b,c,d,x,s,t) {
- return xx((b & c) | ((~b) & d), a, b, x, s, t);
- }
- function gg(a,b,c,d,x,s,t) {
- return xx((b & d) | (c & (~d)), a, b, x, s, t);
- }
- function hh(a,b,c,d,x,s,t) { return xx(b ^ c ^ d, a, b, x, s, t); }
- function ii(a,b,c,d,x,s,t) { return xx(c ^ (b | (~d)), a, b, x, s, t); }
- function md5(buffer, length) {
- var i = length;
- buffer[i >> 2] |= 0x80 << (8 * (i & 3));
- for (i = (i & ~0x3) + 4;(i & 0x3F) < 56 ;i += 4)
- buffer[i >> 2] = 0;
- buffer[i >> 2] = length << 3;
- i += 4;
- buffer[i >> 2] = (length >> 29) & 0x1FFFFFFF;
- var w = [0x67452301, 0xEFCDAB89, 0x98BADCFE, 0x10325476];
- for(i = 0; i < buffer.length; i += 16) {
- var a = w[0], b = w[1], c = w[2], d = w[3];
- a = ff(a, b, c, d, buffer[i+ 0], 7, 0xD76AA478);
- d = ff(d, a, b, c, buffer[i+ 1], 12, 0xE8C7B756);
- c = ff(c, d, a, b, buffer[i+ 2], 17, 0x242070DB);
- b = ff(b, c, d, a, buffer[i+ 3], 22, 0xC1BDCEEE);
- a = ff(a, b, c, d, buffer[i+ 4], 7, 0xF57C0FAF);
- d = ff(d, a, b, c, buffer[i+ 5], 12, 0x4787C62A);
- c = ff(c, d, a, b, buffer[i+ 6], 17, 0xA8304613);
- b = ff(b, c, d, a, buffer[i+ 7], 22, 0xFD469501);
- a = ff(a, b, c, d, buffer[i+ 8], 7, 0x698098D8);
- d = ff(d, a, b, c, buffer[i+ 9], 12, 0x8B44F7AF);
- c = ff(c, d, a, b, buffer[i+10], 17, 0xFFFF5BB1);
- b = ff(b, c, d, a, buffer[i+11], 22, 0x895CD7BE);
- a = ff(a, b, c, d, buffer[i+12], 7, 0x6B901122);
- d = ff(d, a, b, c, buffer[i+13], 12, 0xFD987193);
- c = ff(c, d, a, b, buffer[i+14], 17, 0xA679438E);
- b = ff(b, c, d, a, buffer[i+15], 22, 0x49B40821);
- a = gg(a, b, c, d, buffer[i+ 1], 5, 0xF61E2562);
- d = gg(d, a, b, c, buffer[i+ 6], 9, 0xC040B340);
- c = gg(c, d, a, b, buffer[i+11], 14, 0x265E5A51);
- b = gg(b, c, d, a, buffer[i+ 0], 20, 0xE9B6C7AA);
- a = gg(a, b, c, d, buffer[i+ 5], 5, 0xD62F105D);
- d = gg(d, a, b, c, buffer[i+10], 9, 0x02441453);
- c = gg(c, d, a, b, buffer[i+15], 14, 0xD8A1E681);
- b = gg(b, c, d, a, buffer[i+ 4], 20, 0xE7D3FBC8);
- a = gg(a, b, c, d, buffer[i+ 9], 5, 0x21E1CDE6);
- d = gg(d, a, b, c, buffer[i+14], 9, 0xC33707D6);
- c = gg(c, d, a, b, buffer[i+ 3], 14, 0xF4D50D87);
- b = gg(b, c, d, a, buffer[i+ 8], 20, 0x455A14ED);
- a = gg(a, b, c, d, buffer[i+13], 5, 0xA9E3E905);
- d = gg(d, a, b, c, buffer[i+ 2], 9, 0xFCEFA3F8);
- c = gg(c, d, a, b, buffer[i+ 7], 14, 0x676F02D9);
- b = gg(b, c, d, a, buffer[i+12], 20, 0x8D2A4C8A);
- a = hh(a, b, c, d, buffer[i+ 5], 4, 0xFFFA3942);
- d = hh(d, a, b, c, buffer[i+ 8], 11, 0x8771F681);
- c = hh(c, d, a, b, buffer[i+11], 16, 0x6D9D6122);
- b = hh(b, c, d, a, buffer[i+14], 23, 0xFDE5380C);
- a = hh(a, b, c, d, buffer[i+ 1], 4, 0xA4BEEA44);
- d = hh(d, a, b, c, buffer[i+ 4], 11, 0x4BDECFA9);
- c = hh(c, d, a, b, buffer[i+ 7], 16, 0xF6BB4B60);
- b = hh(b, c, d, a, buffer[i+10], 23, 0xBEBFBC70);
- a = hh(a, b, c, d, buffer[i+13], 4, 0x289B7EC6);
- d = hh(d, a, b, c, buffer[i+ 0], 11, 0xEAA127FA);
- c = hh(c, d, a, b, buffer[i+ 3], 16, 0xD4EF3085);
- b = hh(b, c, d, a, buffer[i+ 6], 23, 0x04881D05);
- a = hh(a, b, c, d, buffer[i+ 9], 4, 0xD9D4D039);
- d = hh(d, a, b, c, buffer[i+12], 11, 0xE6DB99E5);
- c = hh(c, d, a, b, buffer[i+15], 16, 0x1FA27CF8);
- b = hh(b, c, d, a, buffer[i+ 2], 23, 0xC4AC5665);
- a = ii(a, b, c, d, buffer[i+ 0], 6, 0xF4292244);
- d = ii(d, a, b, c, buffer[i+ 7], 10, 0x432AFF97);
- c = ii(c, d, a, b, buffer[i+14], 15, 0xAB9423A7);
- b = ii(b, c, d, a, buffer[i+ 5], 21, 0xFC93A039);
- a = ii(a, b, c, d, buffer[i+12], 6, 0x655B59C3);
- d = ii(d, a, b, c, buffer[i+ 3], 10, 0x8F0CCC92);
- c = ii(c, d, a, b, buffer[i+10], 15, 0xFFEFF47D);
- b = ii(b, c, d, a, buffer[i+ 1], 21, 0x85845DD1);
- a = ii(a, b, c, d, buffer[i+ 8], 6, 0x6FA87E4F);
- d = ii(d, a, b, c, buffer[i+15], 10, 0xFE2CE6E0);
- c = ii(c, d, a, b, buffer[i+ 6], 15, 0xA3014314);
- b = ii(b, c, d, a, buffer[i+13], 21, 0x4E0811A1);
- a = ii(a, b, c, d, buffer[i+ 4], 6, 0xF7537E82);
- d = ii(d, a, b, c, buffer[i+11], 10, 0xBD3AF235);
- c = ii(c, d, a, b, buffer[i+ 2], 15, 0x2AD7D2BB);
- b = ii(b, c, d, a, buffer[i+ 9], 21, 0xEB86D391);
- w[0] = add(a, w[0]);
- w[1] = add(b, w[1]);
- w[2] = add(c, w[2]);
- w[3] = add(d, w[3]);
- }
- var t = [];
- for (var i = 0; i < 4; i++)
- for (var j = 0; j < 4; j++)
- t[i * 4 + j] = (w[i] >> (8 * j)) & 0xFF;
- return t;
- }
- return function (s, ofs, len) {
- var buf = [];
- if (s.array) {
- var a = s.array;
- for (var i = 0; i < len; i+=4) {
- var j = i + ofs;
- buf[i>>2] = a[j] | (a[j+1] << 8) | (a[j+2] << 16) | (a[j+3] << 24);
- }
- for (; i < len; i++) buf[i>>2] |= a[i + ofs] << (8 * (i & 3));
- } else {
- var b = s.getFullBytes();
- for (var i = 0; i < len; i+=4) {
- var j = i + ofs;
- buf[i>>2] =
- b.charCodeAt(j) | (b.charCodeAt(j+1) << 8) |
- (b.charCodeAt(j+2) << 16) | (b.charCodeAt(j+3) << 24);
- }
- for (; i < len; i++) buf[i>>2] |= b.charCodeAt(i + ofs) << (8 * (i & 3));
- }
- return new MlStringFromArray(md5(buf, len));
- }
-} ();
-function caml_ml_out_channels_list () { return 0; }
-function caml_mod(x,y) {
- if (y == 0) caml_raise_zero_divide ();
- return x%y;
-}
-function caml_mul(x,y) {
- return ((((x >> 16) * y) << 16) + (x & 0xffff) * y)|0;
-}
-function caml_obj_block (tag, size) {
- var o = [tag];
- for (var i = 1; i <= size; i++) o[i] = 0;
- return o;
-}
-function caml_register_global (n, v) { caml_global_data[n + 1] = v; }
-var caml_named_values = {};
-function caml_register_named_value(nm,v) {
- caml_named_values[nm] = v; return 0;
-}
-function caml_string_equal(s1, s2) {
- var b1 = s1.fullBytes;
- var b2 = s2.fullBytes;
- if (b1 != null && b2 != null) return (b1 == b2)?1:0;
- return (s1.getFullBytes () == s2.getFullBytes ())?1:0;
-}
-function caml_string_notequal(s1, s2) { return 1-caml_string_equal(s1, s2); }
-function caml_sys_get_config () {
- return [0, new MlWrappedString("Unix"), 32];
-}
-function caml_update_dummy (x, y) {
- if( typeof y==="function" ) { x.fun = y; return 0; }
- if( y.fun ) { x.fun = y.fun; return 0; }
- var i = y.length; while (i--) x[i] = y[i]; return 0;
-}
-(function(){function zm(Dw,Dx,Dy,Dz,DA,DB,DC,DD,DE){return Dw.length==8?Dw(Dx,Dy,Dz,DA,DB,DC,DD,DE):caml_call_gen(Dw,[Dx,Dy,Dz,DA,DB,DC,DD,DE]);}function zz(Do,Dp,Dq,Dr,Ds,Dt,Du,Dv){return Do.length==7?Do(Dp,Dq,Dr,Ds,Dt,Du,Dv):caml_call_gen(Do,[Dp,Dq,Dr,Ds,Dt,Du,Dv]);}function nm(Dh,Di,Dj,Dk,Dl,Dm,Dn){return Dh.length==6?Dh(Di,Dj,Dk,Dl,Dm,Dn):caml_call_gen(Dh,[Di,Dj,Dk,Dl,Dm,Dn]);}function e7(Dd,De,Df,Dg){return Dd.length==3?Dd(De,Df,Dg):caml_call_gen(Dd,[De,Df,Dg]);}function cf(Da,Db,Dc){return Da.length==2?Da(Db,Dc):caml_call_gen(Da,[Db,Dc]);}function cq(C_,C$){return C_.length==1?C_(C$):caml_call_gen(C_,[C$]);}var a=[0,new MlString("Failure")],b=[0,new MlString("Invalid_argument")],c=[0,new MlString("Not_found")],d=[0,new MlString("Assert_failure")],e=[0,0,0,0,0],f=new MlString("scene.json"),g=[0,new MlString("value"),new MlString("upper"),new MlString("step_increment"),new MlString("set_value"),new MlString("set_bounds"),new MlString("page_size"),new MlString("page_increment"),new MlString("lower")],h=[0,new MlString("set_value"),new MlString("set_bounds"),new MlString("step_increment"),new MlString("page_increment"),new MlString("lower"),new MlString("page_size"),new MlString("upper"),new MlString("value")],i=[0,new MlString("_value"),new MlString("_lower"),new MlString("_upper"),new MlString("_step_incr"),new MlString("_page_incr"),new MlString("_page_size")];caml_register_global(5,[0,new MlString("Division_by_zero")]);caml_register_global(3,b);caml_register_global(2,a);var bQ=new MlString("%.12g"),bP=new MlString("."),bO=new MlString("%d"),bN=new MlString("true"),bM=new MlString("false"),bL=new MlString("Pervasives.do_at_exit"),bK=new MlString("Array.blit"),bJ=new MlString("\\b"),bI=new MlString("\\t"),bH=new MlString("\\n"),bG=new MlString("\\r"),bF=new MlString("\\\\"),bE=new MlString("\\'"),bD=new MlString(""),bC=new MlString("String.blit"),bB=new MlString("String.sub"),bA=new MlString("Map.remove_min_elt"),bz=[0,0,0,0],by=[0,new MlString("map.ml"),267,10],bx=[0,0,0],bw=new MlString("Map.bal"),bv=new MlString("Map.bal"),bu=new MlString("Map.bal"),bt=new MlString("Map.bal"),bs=new MlString("Buffer.add: cannot grow buffer"),br=new MlString("%"),bq=new MlString(""),bp=new MlString(""),bo=new MlString("\""),bn=new MlString("\""),bm=new MlString("'"),bl=new MlString("'"),bk=new MlString("."),bj=new MlString("printf: bad positional specification (0)."),bi=new MlString("%_"),bh=[0,new MlString("printf.ml"),144,8],bg=new MlString("''"),bf=new MlString("Printf: premature end of format string ``"),be=new MlString("''"),bd=new MlString(" in format string ``"),bc=new MlString(", at char number "),bb=new MlString("Printf: bad conversion %"),ba=new MlString("Sformat.index_of_int: negative argument "),a$=new MlString("x"),a_=new MlString(""),a9=[0,new MlString("src/core/lwt.ml"),477,20],a8=[0,new MlString("src/core/lwt.ml"),480,8],a7=[0,new MlString("src/core/lwt.ml"),440,20],a6=[0,new MlString("src/core/lwt.ml"),443,8],a5=new MlString("Lwt.fast_connect"),a4=new MlString("Lwt.connect"),a3=new MlString("Lwt.wakeup_exn"),a2=new MlString("Lwt.wakeup"),a1=new MlString("Lwt.Canceled"),a0=new MlString("return;"),aZ=new MlString("onmousewheel"),aY=new MlString("function"),aX=new MlString("onmousewheel"),aW=new MlString("canvas"),aV=new MlString("p"),aU=new MlString("div"),aT=new MlString("on"),aS=new MlString("mouseup"),aR=new MlString("mousemove"),aQ=new MlString("mousewheel"),aP=new MlString("DOMMouseScroll"),aO=new MlString("2d"),aN=new MlString("Dom_html.Canvas_not_available"),aM=new MlString("\\$&"),aL=new MlString("$$$$"),aK=new MlString("g"),aJ=new MlString("g"),aI=new MlString("[$]"),aH=new MlString("[\\][()\\\\|+*.?{}^$]"),aG=[0,new MlString(""),0],aF=new MlString(""),aE=new MlString("="),aD=new MlString("&"),aC=new MlString("%2B"),aB=new MlString("Url.Local_exn"),aA=new MlString("+"),az=new MlString("^([Hh][Tt][Tt][Pp][Ss]?)://([0-9a-zA-Z.-]+|\\[[0-9a-zA-Z.-]+\\]|\\[[0-9A-Fa-f:.]+\\])?(:([0-9]+))?/([^\\?#]*)(\\?([^#])*)?(#(.*))?$"),ay=new MlString("^([Ff][Ii][Ll][Ee])://([^\\?#]*)(\\?([^#])*)?(#(.*))?$"),ax=new MlString("browser can't read file: unimplemented"),aw=new MlString("utf8"),av=[0,new MlString("file.ml"),109,15],au=new MlString("string"),at=new MlString("can't retrieve file name: not implemented"),as=new MlString(""),ar=new MlString("POST"),aq=new MlString("multipart/form-data; boundary="),ap=new MlString("POST"),ao=[0,new MlString("POST"),[0,new MlString("application/x-www-form-urlencoded")],126925477],an=[0,new MlString("POST"),0,126925477],am=new MlString("GET"),al=new MlString("?"),ak=new MlString("Content-type"),aj=new MlString("="),ai=new MlString("="),ah=new MlString("&"),ag=new MlString("Content-Type: application/octet-stream\r\n"),af=new MlString("\"\r\n"),ae=new MlString("\"; filename=\""),ad=new MlString("Content-Disposition: form-data; name=\""),ac=new MlString("\r\n"),ab=new MlString("\r\n"),aa=new MlString("\r\n"),$=new MlString("--"),_=new MlString("\r\n"),Z=new MlString("\"\r\n\r\n"),Y=new MlString("Content-Disposition: form-data; name=\""),X=new MlString("--\r\n"),W=new MlString("--"),V=new MlString("js_of_ocaml-------------------"),U=new MlString("Msxml2.XMLHTTP"),T=new MlString("Msxml3.XMLHTTP"),S=new MlString("Microsoft.XMLHTTP"),R=[0,new MlString("xmlHttpRequest.ml"),64,2],Q=new MlString("XmlHttpRequest.Wrong_headers"),P=[0,0,0],O=[0,new MlString("viewer_common.ml"),260,8],N=[0,new MlString("viewer_common.ml"),263,8],M=[0,new MlString("viewer_common.ml"),269,6],L=[0,new MlString("viewer_common.ml"),272,6],K=[0,new MlString("viewer_common.ml"),122,63],J=new MlString("%dpx"),I=[0,0],H=[0,0],G=[0,1],F=[0,20],E=new MlString("absolute"),D=new MlString("0px"),C=new MlString("1px"),B=new MlString("black"),A=new MlString("absolute"),z=new MlString("2px solid black"),y=new MlString("1px"),x=new MlString("10px"),w=new MlString("10px"),v=new MlString("inline"),u=new MlString("hidden"),t=new MlString("hidden"),s=new MlString("0px"),r=new MlString("Loading graph..."),q=new MlString("none"),p=new MlString("default"),o=new MlString("move"),n=[0,new MlString("viewer_js.ml"),87,26],m=new MlString("center"),l=new MlString("white");function k(j){throw [0,a,j];}function bS(bR){throw [0,b,bR];}function bV(bU,bT){return caml_lessequal(bU,bT)?bU:bT;}function bY(bX,bW){return caml_greaterequal(bX,bW)?bX:bW;}function b4(bZ,b1){var b0=bZ.getLen(),b2=b1.getLen(),b3=caml_create_string(b0+b2|0);caml_blit_string(bZ,0,b3,0,b0);caml_blit_string(b1,0,b3,b0,b2);return b3;}function b6(b5){return caml_format_int(bO,b5);}function b$(b_){var b7=caml_ml_out_channels_list(0);for(;;){if(b7){var b8=b7[2];try {}catch(b9){}var b7=b8;continue;}return 0;}}caml_register_named_value(bL,b$);function ch(ce,cb){var ca=0,cc=cb.length-1-1|0;if(!(cc
+
+
+
+ Graph viewer
+
+
+
+
+
diff -Nru js-of-ocaml-1.4/doc/manual-aux/graph_viewer/jsviewer.js js-of-ocaml-2.2/doc/manual-aux/graph_viewer/jsviewer.js
--- js-of-ocaml-1.4/doc/manual-aux/graph_viewer/jsviewer.js 1970-01-01 00:00:00.000000000 +0000
+++ js-of-ocaml-2.2/doc/manual-aux/graph_viewer/jsviewer.js 2014-05-15 08:37:39.000000000 +0000
@@ -0,0 +1,1532 @@
+// Generated by js_of_ocaml 2.0+git-03482cf
+(function(z){"use strict";var
+dn=125,ds=123,fC=254,ai=255,fB=108,fe='"',bE="Map.bal",R=16777215,C=-659372076,dr="=",fd="function",fo='Content-Disposition: form-data; name="',fp="step_increment",fq=250,al=0.5,fc="jsError",bD="POST",dm=2147483,e9=-550809787,a2=115,dv=102,fA="&",e8="0px",dq=120,e7="--",e6=122,dp=117,bC=126925477,g="",bt=781515420,aW=307110897,aZ=100,M="0",fz=248,fb="set_bounds",fy="upper",du=103,fx="fd ",e5=936573133,fn="absolute",aY=-292814788,aV="viewer_common.ml",fm=1e3,ay="src/core/lwt.ml",e4="10px",ax=".",bA=65535,aX="+",aU="g",dl="f",t=834174833,e3="onmousewheel",ak=105,fa="%d",e$=443,fw=-88,a1=110,e_="lower",bs="?",bv="'",bu="int_of_string",fl=-32,fk="page_size",dt=111,fv="1px",Q=" ",a0="e",fj="lastIndex",bB=891486873,e2="hidden",e1=":",aj="-",aw=-48,fi="nan",dk=116,bz="\r\n",fh="value",fg="%.12g",dx=" : file already exists",dw=-635267918,fu="set_value",by=675223906,$="/",bx=114,bw="#",ft=101,fr="page_increment",fs="index out of bounds",ff=-2147483648,y="number";function
+fT(a,b){throw[0,a,b]}function
+dB(a){if(a.charCodeAt(a.length-1)==10)a=a.substr(0,a.length-1);var
+b=z.console;b&&b.error&&b.error(a)}var
+q=[0];function
+a5(a,b){if(!a)return g;if(a&1)return a5(a-1,b)+b;var
+c=a5(a>>1,b);return c+c}function
+v(a){if(a!=null){this.bytes=this.fullBytes=a;this.last=this.len=a.length}}function
+fU(){fT(q[4],new
+v(fs))}v.prototype={string:null,bytes:null,fullBytes:null,array:null,len:null,last:0,toJsString:function(){var
+a=this.getFullBytes();try{return this.string=decodeURIComponent(escape(a))}catch(f){dB('MlString.toJsString: wrong encoding for "%s" ',a);return a}},toBytes:function(){if(this.string!=null)try{var
+a=unescape(encodeURIComponent(this.string))}catch(f){dB('MlString.toBytes: wrong encoding for "%s" ',this.string);var
+a=this.string}else{var
+a=g,c=this.array,d=c.length;for(var
+b=0;b=0;e--)b[c+e]=g[a+e];else{var
+f=this.bytes;if(f==null)f=this.toBytes();var
+h=this.last-a;if(d<=h)for(var
+e=0;e=this.len)fU();return this.get(a)},set:function(a,b){var
+c=this.array;if(!c){if(this.last==a){this.bytes+=String.fromCharCode(b&ai);this.last++;return 0}c=this.toArray()}else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;c[a]=b&ai;return 0},safeSet:function(a,b){if(this.len==null)this.toBytes();if(a<0||a>=this.len)fU();this.set(a,b)},fill:function(a,b,c){if(a>=this.last&&this.last&&c==0)return;var
+d=this.array;if(!d)d=this.toArray();else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;var
+f=a+b;for(var
+e=a;ea.string)return 1;return 0}var
+b=this.getFullBytes(),c=a.getFullBytes();if(bc)return 1;return 0},equal:function(a){if(this.string!=null&&a.string!=null)return this.string==a.string;return this.getFullBytes()==a.getFullBytes()},lessThan:function(a){if(this.string!=null&&a.string!=null)return this.string=1;f--)c[d+f]=a[b+f]}function
+dA(a,b){fT(a,new
+N(b))}function
+aA(a){dA(q[4],a)}function
+fF(){aA(fs)}function
+jG(a,b){if(b<0||b>=a.length-1)fF();return a[b+1]}function
+jH(a,b,c){if(b<0||b>=a.length-1)fF();a[b+1]=c;return 0}function
+fG(a,b,c,d,e){if(e===0)return;if(d===c.last&&c.bytes!=null){var
+f=a.bytes;if(f==null)f=a.toBytes();if(b>0||a.last>e)f=f.slice(b,b+e);c.bytes+=f;c.last+=f.length;return}var
+g=c.array;if(!g)g=c.toArray();else
+c.bytes=c.string=null;a.blitToArray(b,g,d,e)}function
+S(c,b){if(c.fun)return S(c.fun,b);var
+a=c.length,d=a-b.length;if(d==0)return c.apply(null,b);else
+if(d<0)return S(c.apply(null,b.slice(0,a)),b.slice(a));else
+return function(a){return S(c,b.concat([a]))}}function
+jI(a){if(isFinite(a)){if(Math.abs(a)>=2.22507385850720138e-308)return 0;if(a!=0)return 1;return 2}return isNaN(a)?4:3}function
+jV(a,b){var
+c=a[3]<<16,d=b[3]<<16;if(c>d)return 1;if(cb[2])return 1;if(a[2]b[1])return 1;if(a[1]1)e.push(a,b,1)}}else
+return 1}else
+if(b
+instanceof
+v||b
+instanceof
+Array&&b[0]===(b[0]|0))return-1;else
+if(typeof
+a!=y&&a&&a.compare)return a.compare(b,c);else{if(ab)return 1;if(a!=b){if(!c)return NaN;if(a==a)return 1;if(b==b)return-1}}if(e.length==0)return 0;var
+h=e.pop();b=e.pop();a=e.pop();if(h+131)aA("format_int: format too long");var
+b={justify:aX,signstyle:aj,filler:Q,alternate:false,base:0,signedconv:false,width:0,uppercase:false,sign:1,prec:-1,conv:dl};for(var
+d=0;d=0&&c<=9){b.width=b.width*10+c;d++}d--;break;case
+ax:b.prec=0;d++;while(c=a.charCodeAt(d)-48,c>=0&&c<=9){b.prec=b.prec*10+c;d++}d--;case"d":case"i":b.signedconv=true;case"u":b.base=10;break;case"x":b.base=16;break;case"X":b.base=16;b.uppercase=true;break;case"o":b.base=8;break;case
+a0:case
+dl:case
+aU:b.signedconv=true;b.conv=c;break;case"E":case"F":case"G":b.signedconv=true;b.uppercase=true;b.conv=c.toLowerCase();break}}return b}function
+dy(a,b){if(a.uppercase)b=b.toUpperCase();var
+e=b.length;if(a.signedconv&&(a.sign<0||a.signstyle!=aj))e++;if(a.alternate){if(a.base==8)e+=1;if(a.base==16)e+=2}var
+c=g;if(a.justify==aX&&a.filler==Q)for(var
+d=e;de){var
+d=i-1;while(c.charAt(d)==M)d--;if(c.charAt(d)==ax)d--;c=c.slice(0,d+1)+c.slice(i);d=c.length;if(c.charAt(d-3)==a0)c=c.slice(0,d-1)+M+c.slice(d-1);break}else{var
+g=e;if(h<0){g-=h+1;c=b.toFixed(g)}else
+while(c=b.toFixed(g),c.length>e+1)g--;if(g){var
+d=c.length-1;while(c.charAt(d)==M)d--;if(c.charAt(d)==ax)d--;c=c.slice(0,d+1)}}break}return dy(f,c)}function
+jQ(a,b){if(a.toString()==fa)return new
+N(g+b);var
+c=dz(a);if(b<0)if(c.signedconv){c.sign=-1;b=-b}else
+b>>>=0;var
+d=b.toString(c.base);if(c.prec>=0){c.filler=Q;var
+e=c.prec-d.length;if(e>0)d=a5(e,M)+d}return dy(c,d)}function
+kp(){fR(q[7])}function
+fE(a){var
+b=a.length;this.array=a;this.len=this.last=b}fE.prototype=new
+v();function
+am(){this.content={}}am.prototype={exists:function(a){return this.content[a]?1:0},mk:function(a,b){this.content[a]=b},get:function(a){return this.content[a]},list:function(){var
+a=[];for(var
+b
+in
+this.content)a.push(b);return a},remove:function(a){delete
+this.content[a]}};var
+bJ=new
+am();bJ.mk(g,new
+am());function
+O(a){dA(q[2],a)}function
+fS(a){a=a
+instanceof
+v?a.toString():a;O(a+": No such file or directory")}function
+bG(a){var
+b=bJ;for(var
+c=0;c1)b.pop();break;case
+ax:case
+g:if(b.length==0)b.push(g);break;default:b.push(d[c]);break}b.orig=a;return b}function
+az(a){this.data=a}az.prototype={content:function(){return this.data},truncate:function(){this.data.length=0}};function
+jR(a){var
+c=a4(a),b=bG(c);if(b
+instanceof
+az)return new
+fE(b.content());kp()}function
+fI(a,b){var
+e=a4(a),c=bJ;for(var
+f=0;f>1|1;if(b=0)}function
+jY(a){return(a[3]|a[2]|a[1])==0}function
+j1(a){return[ai,a&R,a>>24&R,a>>31&bA]}function
+j2(a,b){var
+c=a[1]-b[1],d=a[2]-b[2]+(c>>24),e=a[3]-b[3]+(d>>24);return[ai,c&R,d&R,e&bA]}function
+fK(a,b){if(a[3]>b[3])return 1;if(a[3]b[2])return 1;if(a[2]b[1])return 1;if(a[1]>23;a[2]=(a[2]<<1|a[1]>>23)&R;a[1]=a[1]<<1&R}function
+jZ(a){a[1]=(a[1]>>>1|a[2]<<23)&R;a[2]=(a[2]>>>1|a[3]<<23)&R;a[3]=a[3]>>>1}function
+j4(a,b){var
+e=0,d=a.slice(),c=b.slice(),f=[ai,0,0,0];while(fK(d,c)>0){e++;fJ(c)}while(e>=0){e--;fJ(f);if(fK(d,c)>=0){f[1]++;d=j2(d,c)}jZ(c)}return[0,f,d]}function
+j3(a){return a[1]|a[2]<<24}function
+jX(a){return a[3]<<16<0}function
+j0(a){var
+b=-a[1],c=-a[2]+(b>>24),d=-a[3]+(c>>24);return[ai,b&R,c&R,d&bA]}function
+jW(a,b){var
+c=dz(a);if(c.signedconv&&jX(b)){c.sign=-1;b=j0(b)}var
+d=g,i=j1(c.base),h="0123456789abcdef";do{var
+f=j4(b,i);b=f[1];d=h.charAt(j3(f[2]))+d}while(!jY(b));if(c.prec>=0){c.filler=Q;var
+e=c.prec-d.length;if(e>0)d=a5(e,M)+d}return dy(c,d)}function
+ko(a){var
+b=0,c=10,d=a.get(0)==45?(b++,-1):1;if(a.get(b)==48)switch(a.get(b+1)){case
+dq:case
+88:c=16;b+=2;break;case
+dt:case
+79:c=8;b+=2;break;case
+98:case
+66:c=2;b+=2;break}return[b,d,c]}function
+fQ(a){if(a>=48&&a<=57)return a-48;if(a>=65&&a<=90)return a-55;if(a>=97&&a<=e6)return a-87;return-1}function
+j5(a){var
+g=ko(a),f=g[0],h=g[1],d=g[2],i=-1>>>0,e=a.get(f),c=fQ(e);if(c<0||c>=d)bF(bu);var
+b=c;for(;;){f++;e=a.get(f);if(e==95)continue;c=fQ(e);if(c<0||c>=d)break;b=d*b+c;if(b>i)bF(bu)}if(f!=a.getLen())bF(bu);b=h*b;if(d==10&&(b|0)!=b)bF(bu);return b|0}function
+j6(a){return+(a>31&&a<127)}function
+j7(a,b,c){return a.apply(b,c.slice(1))}function
+j8(a){return a.getFullBytes()}function
+j9(){var
+b=z.console?z.console:{},c=["log","debug","info","warn","error","assert","dir","dirxml","trace","group","groupCollapsed","groupEnd","time","timeEnd"];function
+d(){}for(var
+a=0;a0?c.call(arguments):[undefined];return S(a,b)}}function
+kc(a,b){return+(a3(a,b,false)<=0)}function
+kd(a,b){var
+d=[0];for(var
+c=1;c<=a;c++)d[c]=b;return d}function
+fM(a){if(!a.opened)O("Cannot flush a closed channel");if(a.buffer==g)return 0;if(a.output)switch(a.output.length){case
+2:a.output(a,a.buffer);break;default:a.output(a.buffer)}a.buffer=g}function
+kA(a){var
+c=a4(a),b=bG(c);return b
+instanceof
+am?1:0}function
+kz(a){var
+b=bJ,d=a4(a),e;for(var
+c=0;c>16)*b<<16)+(a&bA)*b|0};var
+ki=Math.imul;function
+kk(a,b){return+(a3(a,b,false)!=0)}function
+kl(a,b){var
+d=[a];for(var
+c=1;c<=b;c++)d[c]=0;return d}function
+km(a){return+(a
+instanceof
+Array)}function
+kn(a){return a
+instanceof
+Array?a[0]:fm}function
+kr(a,b){q[a+1]=b}var
+fO={};function
+ks(a,b){fO[a.toString()]=b;return 0}function
+ku(a,b){return a.compare(b)}function
+kv(a,b){var
+c=a.fullBytes,d=b.fullBytes;if(c!=null&&d!=null)return c==d?1:0;return a.getFullBytes()==b.getFullBytes()?1:0}function
+kw(a,b){return 1-kv(a,b)}function
+kx(){return 32}function
+ky(a){if(z.quit)z.quit(a);aA("Function 'exit' not implemented")}function
+kB(a){var
+b=1;while(a&&a.joo_tramp){a=a.joo_tramp.apply(null,a.joo_args);b++}return a}function
+kC(a,b){return{joo_tramp:a,joo_args:b}}function
+kD(a,b){if(typeof
+b===fd){a.fun=b;return 0}if(b.fun){a.fun=b.fun;return 0}var
+c=b.length;while(c--)a[c]=b[c];return 0}function
+kj(a){return fO[a]}function
+kE(a){if(a
+instanceof
+Array)return a;if(z.RangeError&&a
+instanceof
+z.RangeError&&a.message&&a.message.match(/maximum call stack/i))return[0,q[9]];if(z.InternalError&&a
+instanceof
+z.InternalError&&a.message&&a.message.match(/too much recursion/i))return[0,q[9]];if(a
+instanceof
+z.Error)return[0,kj(fc),a];return[0,q[3],new
+N(String(a))]}var
+F=jG,k=jH,ag=fG,X=fH,eZ=jM,e0=jN,de=jP,bp=jQ,f=jT,eV=j5,df=j6,u=j8,_=ka,aT=kb,K=kd,eT=fM,eS=kf,eU=kh,dd=ki,e=fP,eY=kl,eW=kn,W=kr,dc=ks,eX=ku,L=kw,br=kB,Z=kC,G=kE;function
+h(a,b){return a.length==1?a(b):S(a,[b])}function
+i(a,b,c){return a.length==2?a(b,c):S(a,[b,c])}function
+o(a,b,c,d){return a.length==3?a(b,c,d):S(a,[b,c,d])}function
+bq(a,b,c,d,e,f){return a.length==5?a(b,c,d,e,f):S(a,[b,c,d,e,f])}function
+di(a,b,c,d,e,f,g){return a.length==6?a(b,c,d,e,f,g):S(a,[b,c,d,e,f,g])}function
+dj(a,b,c,d,e,f,g,h){return a.length==7?a(b,c,d,e,f,g,h):S(a,[b,c,d,e,f,g,h])}fI("/scene.json",'[0,[0,0,0,2810,3930],\n [0,[0,6,3880.68,304,3919.68],[0,53.5,3887.87,256.5,3911.87],\n [0,596,3880.68,882,3919.68],[0,641.5,3887.87,836.5,3911.87],\n [0,96,3804.67,214,3843.67],[0,117.5,3811.87,192.5,3832.87],\n [0,680,3804.67,798,3843.67],[0,701.5,3811.87,776.5,3832.87],\n [0,95,3729.67,215,3768.67],[0,115.5,3736.87,194.5,3757.87],\n [0,679,3729.67,799,3768.67],[0,699.5,3736.87,778.5,3757.87],\n [0,74,3653.67,236,3692.67],[0,100.5,3660.87,209.5,3684.87],\n [0,696,3653.67,782,3692.67],[0,712,3660.87,766,3681.87],\n [0,34,3578.67,276,3617.67],[0,73,3585.87,237,3609.87],\n [0,520,3578.67,958,3617.67],[0,589,3585.87,889,3609.87],\n [0,49,3502.67,261,3541.67],[0,82,3509.87,228,3530.87],\n [0,633,3502.67,845,3541.67],[0,666,3509.87,812,3530.87],\n [0,47,3427.67,263,3466.67],[0,81,3434.87,229,3458.87],\n [0,631,3427.67,847,3466.67],[0,665,3434.87,813,3458.87],\n [0,2763,2099.7,2805,2142.7],[0,2774,2110.3,2794,2130.3],\n [0,2266,2101.7,2466,2140.7],[0,2298,2108.9,2434,2129.9],\n [0,2258,2176.7,2474,2215.7],[0,2292.5,2183.9,2439.5,2204.9],\n [0,2261,2252.7,2471,2291.7],[0,2294,2259.9,2438,2280.9],\n [0,2262,1950.7,2470,1989.7],[0,2295,1957.9,2437,1978.9],\n [0,2225,2025.7,2507,2064.7],[0,2268.5,2032.9,2463.5,2056.9],\n [0,1243,2987.67,1425,3026.67],[0,1273,2994.87,1395,3015.87],\n [0,1723,2987.67,1957,3026.67],[0,1762,2994.87,1918,3017.87],\n [0,64,2410.7,246,2449.7],[0,93,2417.9,217,2441.9],\n [0,648,2410.7,830,2449.7],[0,677,2417.9,801,2441.9],\n [0,62,2334.7,248,2373.7],[0,92.5,2341.9,217.5,2365.9],\n [0,650,2334.7,828,2373.7],[0,679,2341.9,799,2365.9],\n [0,73,2259.7,237,2298.7],[0,101,2266.9,209,2287.9],\n [0,623,2259.7,855,2298.7],[0,660.5,2266.9,817.5,2290.9],\n [0,1730,2642.7,1950,2681.7],[0,1766.5,2649.9,1913.5,2673.9],\n [0,2295,2642.7,2437,2681.7],[0,2318.5,2649.9,2413.5,2673.9],\n [0,41,2183.7,269,2222.7],[0,78.5,2190.9,231.5,2214.9],\n [0,664,2183.7,814,2222.7],[0,690.5,2190.9,787.5,2214.9],\n [0,79,2108.7,231,2147.7],[0,103.5,2115.9,206.5,2136.9],\n [0,662,2108.7,816,2147.7],[0,687.5,2115.9,790.5,2136.9],\n [0,76,2032.7,234,2071.7],[0,103,2039.9,207,2063.9],\n [0,628,2032.7,850,2071.7],[0,664.5,2039.9,813.5,2063.9],\n [0,1222,1857.7,1446,1896.7],[0,1259,1864.9,1409,1888.9],\n [0,1711,1859.7,1969,1898.7],[0,1753.5,1866.9,1926.5,1890.9],\n [0,1761,2551.7,1919,2590.7],[0,1787,2558.9,1893,2582.9],\n [0,2268,2403.7,2464,2442.7],[0,2300,2410.9,2432,2434.9],\n [0,73,1622.7,237,1661.7],[0,101.5,1629.9,208.5,1652.9],\n [0,670,1622.7,808,1661.7],[0,693.5,1629.9,784.5,1653.9],\n [0,54,1547.7,256,1586.7],[0,88.5,1554.9,221.5,1578.9],\n [0,638,1547.7,840,1586.7],[0,672.5,1554.9,805.5,1578.9],\n [0,1236,3169.67,1432,3208.67],[0,1269,3176.87,1399,3199.87],\n [0,1742,3234.67,1938,3273.67],[0,1775,3241.87,1905,3264.87],\n [0,1711,2817.7,1969,2856.7],[0,1752,2824.9,1928,2848.9],\n [0,2257,2817.7,2475,2856.7],[0,2291,2824.9,2441,2848.9],\n [0,1819,1779.7,1861,1822.7],[0,1830,1790.3,1850,1810.3],\n [0,1223,1687.7,1445,1726.7],[0,1259.5,1694.9,1408.5,1717.9],\n [0,1172,1782.7,1496,1821.7],[0,1223.5,1789.9,1444.5,1813.9],\n [0,1172,1953.7,1496,1992.7],[0,1223.5,1960.9,1444.5,1984.9],\n [0,35,1471.7,275,1510.7],[0,72,1478.9,238,1502.9],\n [0,619,1471.7,859,1510.7],[0,656,1478.9,822,1502.9],\n [0,52,1396.7,258,1435.7],[0,85,1403.9,225,1424.9],\n [0,636,1396.7,842,1435.7],[0,669,1403.9,809,1424.9],\n [0,74,1320.7,236,1359.7],[0,102,1327.9,208,1351.9],\n [0,663,1320.7,815,1359.7],[0,688.5,1327.9,789.5,1351.9],\n [0,64,1245.7,246,1284.7],[0,95.5,1252.9,214.5,1276.9],\n [0,679,1245.7,799,1284.7],[0,699,1252.9,779,1276.9],\n [0,45,1169.7,265,1208.7],[0,82,1176.9,228,1200.9],\n [0,619,1169.7,859,1208.7],[0,656.5,1176.9,821.5,1200.9],\n [0,119,1094.7,191,1133.7],[0,134,1101.9,176,1122.9],\n [0,651,1094.7,827,1133.7],[0,680,1101.9,798,1125.9],\n [0,120,792.699,190,831.699],[0,133.5,799.9,176.5,823.9],\n [0,649,792.699,829,831.699],[0,678,799.9,800,823.9],\n [0,718,904.699,760,947.699],[0,729,915.3,749,935.3],\n [0,68,867.699,242,906.699],[0,96,874.9,214,898.9],\n [0,54,943.699,256,982.699],[0,88,950.9,222,974.9],\n [0,106,1018.7,204,1057.7],[0,122.5,1025.9,187.5,1049.9],\n [0,1771,2221.7,1909,2260.7],[0,1793.5,2228.9,1886.5,2249.9],\n [0,2184,2327.7,2548,2366.7],[0,2238,2334.9,2494,2358.9],\n [0,125,716.699,185,755.699],[0,138,723.9,172,744.9],\n [0,691,716.699,787,755.699],[0,709,723.9,769,744.9],\n [0,11,641.699,299,680.699],[0,58.5,648.9,251.5,672.9],\n [0,603,576.699,875,615.699],[0,647,583.9,831,607.9],\n [0,1740,611.699,1940,650.699],[0,1773,618.9,1907,642.9],\n [0,2295,611.699,2437,650.699],[0,2321,618.9,2411,642.9],\n [0,100,501.699,210,540.699],[0,119.5,509.9,190.5,529.9],\n [0,662,501.699,816,540.699],[0,688,509.9,790,529.9],\n [0,67,425.699,243,464.699],[0,95,432.9,215,456.9],\n [0,664,425.699,814,464.699],[0,688.5,432.9,789.5,453.9],\n [0,718,272.699,760,315.699],[0,729,283.3,749,303.3],\n [0,9,199.699,301,238.699],[0,54,206.9,256,230.9],\n [0,12,274.699,298,313.699],[0,56,281.9,254,305.9],\n [0,4,350.699,306,389.699],[0,51.5,357.9,258.5,381.9],\n [0,42,3287.67,268,3326.67],[0,77.5,3294.87,232.5,3318.87],\n [0,617,3351.67,861,3390.67],[0,655.5,3358.87,822.5,3382.87],\n [0,1819,84.6992,1861,127.699],[0,1830,95.3,1850,115.3],\n [0,1222,10.6992,1446,49.6992],[0,1257,17.9,1411,41.9],\n [0,1188,86.6992,1480,125.699],[0,1233.5,93.9,1434.5,117.9],\n [0,1215,161.699,1453,200.699],[0,1252,168.9,1416,192.9],\n [0,52,48.6992,258,87.6992],[0,87.5,55.9,222.5,78.9],\n [0,75,123.699,235,162.699],[0,101.5,130.9,208.5,154.9],\n [0,716,120.199,762,166.199],[0,727,134.6,751,152.6],\n [0,33,1723.7,277,1762.7],[0,72.5,1730.9,237.5,1753.9],\n [0,8,1808.7,302,1847.7],[0,53.5,1815.9,256.5,1839.9],\n [0,8,1936.7,302,1975.7],[0,53.5,1943.9,256.5,1967.9],\n [0,668,2684.7,810,2723.7],[0,691.5,2691.9,786.5,2712.9],\n [0,648,2817.7,830,2856.7],[0,679.5,2824.9,798.5,2848.9],\n [0,639,2565.7,839,2604.7],[0,671,2572.9,807,2596.9],\n [0,652,2485.7,826,2524.7],[0,679.5,2492.9,798.5,2516.9],\n [0,675,3017.67,803,3056.67],[0,696,3024.87,782,3045.87],\n [0,675,3140.67,803,3179.67],[0,696,3147.87,782,3171.87],\n [0,1244,2157.7,1424,2196.7],[0,1274,2164.9,1394,2188.9],\n [0,1243,2359.7,1425,2398.7],[0,1273,2366.9,1395,2387.9],\n [0,303.121,3899.18,596.828,3901.18],[0,213.129,3823.17,680.672,3825.17],\n [0,214.75,3748.17,679.328,3750.17],[0,235.59,3672.17,696.328,3674.17],\n [0,275.301,3597.17,520.871,3599.17],[0,260.762,3521.17,633.039,3523.17],\n [0,262.109,3446.17,631.578,3448.17],[0,2465.1,2120.2,2763.2,2122.2],\n [0,2439.62,2123.82,2763.98,2183.88],[0,2427.96,2129.3,2766.04,2258.57],\n [0,2428.86,1983.43,2766.04,2113],[0,2446.92,2058.91,2763.88,2118.48],\n [0,1424.2,3006.17,1723.9,3008.17],[0,245.289,2429.2,648.551,2431.2],\n [0,247.539,2353.2,650.238,2355.2],[0,236.512,2278.2,623.422,2280.2],\n [0,1949.6,2661.2,2295.2,2663.2],[0,268.289,2202.2,664.891,2204.2],\n [0,230.75,2127.2,662.461,2129.2],[0,233.762,2051.2,628.391,2053.2],\n [0,1445,1876.6,1711.3,1879.7],[0,1889.23,2437.34,2312.67,2558.26],\n [0,236.512,1641.2,670.828,1643.2],[0,255.73,1566.2,638.078,1568.2],\n [0,1414.07,3198.48,1759.93,3244.86],[0,1968.7,2836.2,2257.7,2838.2],\n [0,1406.82,1719.71,1819.98,1798.38],[0,1495.1,1800.2,1819.3,1802.9],\n [0,1384.07,1806.86,1820.93,1957.05],[0,274.59,1490.2,619.32,1492.2],\n [0,257.73,1415.2,636.359,1417.2],[0,235.281,1339.2,663.309,1341.2],\n [0,245.289,1264.2,679.301,1266.2],[0,264.5,1188.2,619.969,1190.2],\n [0,190.648,1113.2,651.969,1115.2],[0,189.352,811.199,649.809,813.199],\n [0,187.039,817.52,719.07,923.18],[0,237.363,891.703,718.516,925.797],\n [0,249.738,926.504,718.473,958.195],[0,197.754,929.02,718.996,1030.88],\n [0,1894.6,2251.22,2285.9,2331.98],[0,184.359,735.199,691.32,737.199],\n [0,262.34,606.707,635.25,650.191],[0,1939.6,630.199,2295.9,632.199],\n [0,209.68,520.199,662.191,522.199],[0,242.121,444.199,664.789,446.199],\n [0,255.93,231.207,718.777,292.594],[0,297.121,293.199,718.43,295.199],\n [0,256.602,295.809,718.59,357.891],[0,247.75,3316.36,641.281,3361.44],\n [0,1415.75,41.5117,1819.75,104.09],[0,1479.3,105.199,1819.1,107.199],\n [0,1418.55,108.211,1819.55,169.59],[0,1732.44,3252.65,1746.62,3262.46],\n [0,265.527,3256.52,1733.63,3304.7],[0,1767.35,3266.04,1782.11,3275.61],\n [0,858.574,3269.62,1769.62,3368.91],[0,1192.57,110.066,1206.9,119.863],\n [0,761.176,113.898,1193.96,142.801],[0,1213.52,168.641,1227.8,178.441],\n [0,761.176,143.605,1214.86,174.598],[0,705.75,138.289,719.781,148.109],\n [0,234.059,142.199,706.75,144.199],[0,1729.4,628.211,1743.53,638.027],\n [0,297.191,632.102,1730.52,659.602],[0,1730.45,622.766,1744.62,632.578],\n [0,870.41,599.398,1731.63,628.699],[0,1231.03,1860.61,1245.54,1870.36],\n [0,251.367,1753.11,1232.71,1866.59],[0,1213.95,1705.92,1228.12,1715.73],\n [0,274.23,1709.8,1215.13,1740.5],[0,1164.61,1801.02,1178.73,1810.83],\n [0,299.246,1804.9,1165.72,1826],[0,1214.81,1867.36,1229.02,1877.17],\n [0,293.957,1833,1216.04,1873.3],[0,1162.7,1965.77,1176.82,1975.59],\n [0,300.734,1957.3,1163.82,1971.7],[0,1219.47,1879.97,1233.8,1889.77],\n [0,283.633,1883.8,1220.87,1948.6],[0,1722.11,2661.73,1736.32,2671.55],\n [0,809.09,2665.6,1723.34,2702.5],[0,1730.73,2819.21,1745.24,2828.96],\n [0,802.828,2710.91,1732.42,2825.19],[0,1700.2,2832.29,1714.23,2842.11],\n [0,829.57,2836.2,1701.2,2838.2],[0,1745.66,2987.88,1760.28,2997.58],\n [0,810.656,2847.31,1747.55,2993.87],[0,1749.33,2671.61,1763.96,2681.3],\n [0,809.812,2675.31,1751.26,2826.89],[0,1750.95,2567.4,1765.03,2577.22],\n [0,838.148,2571.3,1752.01,2584.9],[0,1727.37,2649.44,1741.7,2659.23],\n [0,831.379,2590.61,1728.77,2655.39],[0,2260.46,2423.54,2274.71,2433.35],\n [0,823.277,2427.4,2261.75,2501.9],[0,1745.99,2643.7,1760.58,2653.41],\n [0,810.801,2514.31,1747.84,2649.69],[0,1749.73,2848.55,1764.42,2858.21],\n [0,792.301,2852.21,1751.78,3028.45],[0,1776.56,3230.96,1791.41,3240.38],\n [0,796.605,3043.79,1779.18,3236.91],[0,1732.71,3245.53,1746.91,3255.34],\n [0,794.543,3167.67,1733.94,3251.47],[0,1741.53,3015.89,1756.11,3025.62],\n [0,795.742,3019.63,1743.34,3153.26],[0,2293.6,2401.59,2308.38,2411.15],\n [0,1390.87,2190.13,2295.93,2407.57],[0,2283.51,2323,2298.31,2332.51],\n [0,1421.48,2171.56,2285.95,2328.97],[0,2254.79,2054.46,2269.32,2064.2],\n [0,1409.38,2058.21,2256.52,2168.49],[0,2259.31,2413.75,2273.52,2423.57],\n [0,1422.86,2382,2260.54,2419.7],[0,2181.51,2348.03,2195.71,2357.85],\n [0,1423.77,2351.9,2182.73,2377.4]],\n [0,[2,155,3900.17,148,18.5,0,[0,"#000000"]],\n [3,155,3903.87,"ubiquity-slideshow-kubuntu","14px serif",[0,"#000000"],0],\n [2,739,3900.17,141.998,18.5,0,[0,"#000000"]],\n [3,739,3903.87,"ubiquity-slideshow-ubuntu","14px serif",[0,"#000000"],0],\n [2,155,3824.17,57.9996,18.5,0,[0,"#000000"]],\n [3,155,3827.87,"tk8.4-doc","14px serif",[0,"#000000"],0],\n [2,739,3824.17,57.9996,18.5,0,[0,"#000000"]],\n [3,739,3827.87,"tk8.5-doc","14px serif",[0,"#000000"],0],\n [2,155,3749.17,59.0004,18.5,0,[0,"#000000"]],\n [3,155,3752.87,"tcl8.4-doc","14px serif",[0,"#000000"],0],\n [2,739,3749.17,59.0004,18.5,0,[0,"#000000"]],\n [3,739,3752.87,"tcl8.5-doc","14px serif",[0,"#000000"],0],\n [2,155,3673.17,79.9992,18.5,0,[0,"#000000"]],\n [3,155,3676.87,"openbsd-inetd","14px serif",[0,"#000000"],0],\n [2,739,3673.17,42.0012,18.5,0,[0,"#000000"]],\n [3,739,3676.87,"xinetd","14px serif",[0,"#000000"],0],\n [2,155,3598.17,119.999,18.5,0,[0,"#000000"]],\n [3,155,3601.87,"network-manager-kde","14px serif",[0,"#000000"],0],\n [2,739,3598.17,218.002,18.5,0,[0,"#000000"]],\n [3,739,3601.87,"plasma-widget-networkmanagement (x 2)","14px serif",\n [0,"#000000"],0],\n [2,155,3522.17,105.001,18.5,0,[0,"#000000"]],\n [3,155,3525.87,"libstdc++6-4.4-doc","14px serif",[0,"#000000"],0],\n [2,739,3522.17,105.001,18.5,0,[0,"#000000"]],\n [3,739,3525.87,"libstdc++6-4.5-doc","14px serif",[0,"#000000"],0],\n [2,155,3447.17,106.999,18.5,0,[0,"#000000"]],\n [3,155,3450.87,"libstdc++6-4.4-dbg","14px serif",[0,"#000000"],0],\n [2,739,3447.17,106.999,18.5,0,[0,"#000000"]],\n [3,739,3450.87,"libstdc++6-4.5-dbg","14px serif",[0,"#000000"],0],\n [2,2784,2121.2,20.0002,20.4998,0,[0,"#ff0000"]],\n [3,2784,2125.3,"#","14px serif",[0,"#ff0000"],0],\n [2,2366,2121.2,99,18.5,0,[0,"#000000"]],\n [3,2366,2124.9,"libsdl1.2debian-all","14px serif",[0,"#000000"],0],\n [2,2366,2196.2,106.999,18.5,0,[0,"#000000"]],\n [3,2366,2199.9,"libsdl1.2debian-alsa","14px serif",[0,"#000000"],0],\n [2,2366,2272.2,104,18.5,0,[0,"#000000"]],\n [3,2366,2275.9,"libsdl1.2debian-esd","14px serif",[0,"#000000"],0],\n [2,2366,1970.2,103,18.5,0,[0,"#000000"]],\n [3,2366,1973.9,"libsdl1.2debian-oss","14px serif",[0,"#000000"],0],\n [2,2366,2045.2,140,18.5,0,[0,"#000000"]],\n [3,2366,2048.9,"libsdl1.2debian-pulseaudio","14px serif",[0,"#000000"],0],\n [2,1334,3007.17,90,18.5,0,[0,"#000000"]],\n [3,1334,3010.87,"libreadline5-dev","14px serif",[0,"#000000"],0],\n [2,1840,3007.17,115.999,18.5,0,[0,"#000000"]],\n [3,1840,3010.87,"libreadline6-dev (x 6)","14px serif",[0,"#000000"],0],\n [2,155,2430.2,90,18.5,0,[0,"#000000"]],\n [3,155,2433.9,"libreadline5-dbg","14px serif",[0,"#000000"],0],\n [2,739,2430.2,90,18.5,0,[0,"#000000"]],\n [3,739,2433.9,"libreadline6-dbg","14px serif",[0,"#000000"],0],\n [2,155,2354.2,92.0016,18.5,0,[0,"#000000"]],\n [3,155,2357.9,"libqt4-dbg (x 24)","14px serif",[0,"#000000"],0],\n [2,739,2354.2,87.9984,18.5,0,[0,"#000000"]],\n [3,739,2357.9,"qt-x11-free-dbg","14px serif",[0,"#000000"],0],\n [2,155,2279.2,81,18.5,0,[0,"#000000"]],\n [3,155,2282.9,"libneon27-dev","14px serif",[0,"#000000"],0],\n [2,739,2279.2,114.998,18.5,0,[0,"#000000"]],\n [3,739,2282.9,"libneon27-gnutls-dev","14px serif",[0,"#000000"],0],\n [2,1840,2662.2,109.001,18.5,0,[0,"#000000"]],\n [3,1840,2665.9,"libjpeg62-dev (x 23)","14px serif",[0,"#000000"],0],\n [2,2366,2662.2,69.9984,18.5,0,[0,"#000000"]],\n [3,2366,2665.9,"libjpeg8-dev","14px serif",[0,"#000000"],0],\n [2,155,2203.2,113,18.5,0,[0,"#000000"]],\n [3,155,2206.9,"libjack-jackd2-0 (x 2)","14px serif",[0,"#000000"],0],\n [2,739,2203.2,74.0016,18.5,0,[0,"#000000"]],\n [3,739,2206.9,"libjack0 (x 3)","14px serif",[0,"#000000"],0],\n [2,155,2128.2,74.9988,18.5,0,[0,"#000000"]],\n [3,155,2131.9,"libiodbc2-dev","14px serif",[0,"#000000"],0],\n [2,739,2128.2,75.9996,18.5,0,[0,"#000000"]],\n [3,739,2131.9,"unixodbc-dev","14px serif",[0,"#000000"],0],\n [2,155,2052.2,78.0012,18.5,0,[0,"#000000"]],\n [3,155,2055.9,"libgpod4 (x 9)","14px serif",[0,"#000000"],0],\n [2,739,2052.2,110.002,18.5,0,[0,"#000000"]],\n [3,739,2055.9,"libgpod4-nogtk (x 2)","14px serif",[0,"#000000"],0],\n [2,1334,1877.2,110.999,18.5,0,[0,"#000000"]],\n [3,1334,1880.9,"libgl1-mesa-glx (x 8)","14px serif",[0,"#000000"],0],\n [2,1840,1879.2,128.002,18.5,0,[0,"#000000"]],\n [3,1840,1882.9,"libgl1-mesa-swx11 (x 3)","14px serif",[0,"#000000"],0],\n [2,1840,2571.2,78.0012,18.5,0,[0,"#000000"]],\n [3,1840,2574.9,"libgd2-noxpm","14px serif",[0,"#000000"],0],\n [2,2366,2423.2,96.9984,18.5,0,[0,"#000000"]],\n [3,2366,2426.9,"libgd2-xpm (x 10)","14px serif",[0,"#000000"],0],\n [2,155,1642.2,81,18.5,0,[0,"#000000"]],\n [3,155,1645.9,"libelf-dev (x 3)","14px serif",[0,"#000000"],0],\n [2,739,1642.2,68.0004,18.5,0,[0,"#000000"]],\n [3,739,1645.9,"libelfg0-dev","14px serif",[0,"#000000"],0],\n [2,155,1567.2,100.001,18.5,0,[0,"#000000"]],\n [3,155,1570.9,"libdb4.7-java (x 3)","14px serif",[0,"#000000"],0],\n [2,739,1567.2,100.001,18.5,0,[0,"#000000"]],\n [3,739,1570.9,"libdb4.8-java (x 3)","14px serif",[0,"#000000"],0],\n [2,1334,3189.17,96.9984,18.5,0,[0,"#000000"]],\n [3,1334,3192.87,"libdb4.7-dev (x 2)","14px serif",[0,"#000000"],0],\n [2,1840,3254.17,96.9984,18.5,0,[0,"#000000"]],\n [3,1840,3257.87,"libdb4.8-dev (x 5)","14px serif",[0,"#000000"],0],\n [2,1840,2837.2,128.002,18.5,0,[0,"#000000"]],\n [3,1840,2840.9,"libcurl4-gnutls-dev (x 4)","14px serif",[0,"#000000"],0],\n [2,2366,2837.2,108,18.5,0,[0,"#000000"]],\n [3,2366,2840.9,"libcurl4-openssl-dev","14px serif",[0,"#000000"],0],\n [2,1840,1801.2,20.0002,20.4998,0,[0,"#ff0000"]],\n [3,1840,1805.3,"#","14px serif",[0,"#ff0000"],0],\n [2,1334,1707.2,110.002,18.5,0,[0,"#000000"]],\n [3,1334,1710.9,"libclutter-1.0-0 (x 2)","14px serif",[0,"#000000"],0],\n [2,1334,1802.2,160.999,18.5,0,[0,"#000000"]],\n [3,1334,1805.9,"libclutter-eglx-es11-1.0-0 (x 2)","14px serif",\n [0,"#000000"],0],\n [2,1334,1973.2,160.999,18.5,0,[0,"#000000"]],\n [3,1334,1976.9,"libclutter-eglx-es20-1.0-0 (x 2)","14px serif",\n [0,"#000000"],0],\n [2,155,1491.2,119.002,18.5,0,[0,"#000000"]],\n [3,155,1494.9,"lib64stdc++6-4.4-dbg","14px serif",[0,"#000000"],0],\n [2,739,1491.2,119.002,18.5,0,[0,"#000000"]],\n [3,739,1494.9,"lib64stdc++6-4.5-dbg","14px serif",[0,"#000000"],0],\n [2,155,1416.2,101.999,18.5,0,[0,"#000000"]],\n [3,155,1419.9,"lib64readline5-dev","14px serif",[0,"#000000"],0],\n [2,739,1416.2,101.999,18.5,0,[0,"#000000"]],\n [3,739,1419.9,"lib64readline6-dev","14px serif",[0,"#000000"],0],\n [2,155,1340.2,79.9992,18.5,0,[0,"#000000"]],\n [3,155,1343.9,"hunspell-tools","14px serif",[0,"#000000"],0],\n [2,739,1340.2,74.9988,18.5,0,[0,"#000000"]],\n [3,739,1343.9,"myspell-tools","14px serif",[0,"#000000"],0],\n [2,155,1265.2,90,18.5,0,[0,"#000000"]],\n [3,155,1268.9,"hunspell-fr (x 3)","14px serif",[0,"#000000"],0],\n [2,739,1265.2,59.0004,18.5,0,[0,"#000000"]],\n [3,739,1268.9,"myspell-fr","14px serif",[0,"#000000"],0],\n [2,155,1189.2,109.001,18.5,0,[0,"#000000"]],\n [3,155,1192.9,"hunspell-de-de (x 3)","14px serif",[0,"#000000"],0],\n [2,739,1189.2,119.002,18.5,0,[0,"#000000"]],\n [3,739,1192.9,"myspell-de-de-oldspell","14px serif",[0,"#000000"],0],\n [2,155,1114.2,34.9999,18.5,0,[0,"#000000"]],\n [3,155,1117.9,"hello","14px serif",[0,"#000000"],0],\n [2,739,1114.2,87.0012,18.5,0,[0,"#000000"]],\n [3,739,1117.9,"hello-debhelper","14px serif",[0,"#000000"],0],\n [2,155,812.2,33.9998,18.5,0,[0,"#000000"]],\n [3,155,815.9,"grub","14px serif",[0,"#000000"],0],\n [2,739,812.2,88.9992,18.5,0,[0,"#000000"]],\n [3,739,815.9,"grub-legacy-ec2","14px serif",[0,"#000000"],0],\n [2,739,926.2,20.0002,20.4998,0,[0,"#ff0000"]],\n [3,739,930.3,"#","14px serif",[0,"#ff0000"],0],\n [2,155,887.2,86.0004,18.5,0,[0,"#000000"]],\n [3,155,890.9,"grub-efi-amd64","14px serif",[0,"#000000"],0],\n [2,155,963.2,100.001,18.5,0,[0,"#000000"]],\n [3,155,966.9,"grub-efi-ia32 (x 2)","14px serif",[0,"#000000"],0],\n [2,155,1038.2,47.9988,18.5,0,[0,"#000000"]],\n [3,155,1041.9,"grub-pc","14px serif",[0,"#000000"],0],\n [2,1840,2241.2,68.0004,18.5,0,[0,"#000000"]],\n [3,1840,2244.9,"foomatic-db","14px serif",[0,"#000000"],0],\n [2,2366,2347.2,181.001,18.5,0,[0,"#000000"]],\n [3,2366,2350.9,"foomatic-db-compressed-ppds (x 4)","14px serif",\n [0,"#000000"],0],\n [2,155,736.2,29.0002,18.5,0,[0,"#000000"]],\n [3,155,739.9,"flex","14px serif",[0,"#000000"],0],\n [2,739,736.2,47.0016,18.5,0,[0,"#000000"]],\n [3,739,739.9,"flex-old","14px serif",[0,"#000000"],0],\n [2,155,661.2,142.999,18.5,0,[0,"#000000"]],\n [3,155,664.9,"exim4-daemon-heavy (x 2)","14px serif",[0,"#000000"],0],\n [2,739,596.2,135,18.5,0,[0,"#000000"]],\n [3,739,599.9,"exim4-daemon-light (x 2)","14px serif",[0,"#000000"],0],\n [2,1840,631.2,99,18.5,0,[0,"#000000"]],\n [3,1840,634.9,"exim4-config (x 5)","14px serif",[0,"#000000"],0],\n [2,2366,631.2,69.9984,18.5,0,[0,"#000000"]],\n [3,2366,634.9,"postfix (x 9)","14px serif",[0,"#000000"],0],\n [2,155,521.2,54,18.5,0,[0,"#000000"]],\n [3,155,524.9,"emacs23","14px serif",[0,"#000000"],0],\n [2,739,521.2,75.9996,18.5,0,[0,"#000000"]],\n [3,739,524.9,"emacs23-nox","14px serif",[0,"#000000"],0],\n [2,155,445.2,87.0012,18.5,0,[0,"#000000"]],\n [3,155,448.9,"debconf-english","14px serif",[0,"#000000"],0],\n [2,739,445.2,74.0016,18.5,0,[0,"#000000"]],\n [3,739,448.9,"debconf-i18n","14px serif",[0,"#000000"],0],\n [2,739,294.2,20.0002,20.4998,0,[0,"#ff0000"]],\n [3,739,298.3,"#","14px serif",[0,"#ff0000"],0],\n [2,155,219.2,145.001,18.5,0,[0,"#000000"]],\n [3,155,222.9,"bacula-common-mysql (x 3)","14px serif",[0,"#000000"],0],\n [2,155,294.2,141.998,18.5,0,[0,"#000000"]],\n [3,155,297.9,"bacula-common-pgsql (x 3)","14px serif",[0,"#000000"],0],\n [2,155,370.2,150.001,18.5,0,[0,"#000000"]],\n [3,155,373.9,"bacula-common-sqlite3 (x 3)","14px serif",[0,"#000000"],0],\n [2,155,3307.17,112,18.5,0,[0,"#000000"]],\n [3,155,3310.87,"apache2-prefork-dev","14px serif",[0,"#000000"],0],\n [2,739,3371.17,121,18.5,0,[0,"#000000"]],\n [3,739,3374.87,"apache2-threaded-dev","14px serif",[0,"#000000"],0],\n [2,1840,106.2,20.0002,20.4998,0,[0,"#ff0000"]],\n [3,1840,110.3,"#","14px serif",[0,"#ff0000"],0],\n [2,1334,30.2,110.999,18.5,0,[0,"#000000"]],\n [3,1334,33.9,"apache2-mpm-event","14px serif",[0,"#000000"],0],\n [2,1334,106.2,145.001,18.5,0,[0,"#000000"]],\n [3,1334,109.9,"apache2-mpm-prefork (x 2)","14px serif",[0,"#000000"],0],\n [2,1334,181.2,118.001,18.5,0,[0,"#000000"]],\n [3,1334,184.9,"apache2-mpm-worker","14px serif",[0,"#000000"],0],\n [2,155,68.2,101.999,18.5,0,[0,"#000000"]],\n [3,155,71.9,"abrowser (x 7049)","14px serif",[0,"#000000"],0],\n [2,155,143.2,78.9984,18.5,0,[0,"#000000"]],\n [3,155,146.9,"eucalyptus-nc","14px serif",[0,"#000000"],0],\n [2,739,143.2,22,22,0,[0,"#0000ff"]],\n [3,739,147.6,"or","14px serif",[0,"#0000ff"],0],\n [2,155,1743.2,121,18.5,0,[0,"#000000"]],\n [3,155,1746.9,"libclutter-1.0-dev (x 2)","14px serif",[0,"#000000"],0],\n [2,155,1828.2,146.002,18.5,0,[0,"#000000"]],\n [3,155,1831.9,"libclutter-eglx-es11-1.0-dev","14px serif",[0,"#000000"],0],\n [2,155,1956.2,146.002,18.5,0,[0,"#000000"]],\n [3,155,1959.9,"libclutter-eglx-es20-1.0-dev","14px serif",[0,"#000000"],0],\n [2,739,2704.2,69.9984,18.5,0,[0,"#000000"]],\n [3,739,2707.9,"libecore-dev","14px serif",[0,"#000000"],0],\n [2,739,2837.2,90,18.5,0,[0,"#000000"]],\n [3,739,2840.9,"libedje-dev (x 2)","14px serif",[0,"#000000"],0],\n [2,739,2585.2,99,18.5,0,[0,"#000000"]],\n [3,739,2588.9,"libgd2-noxpm-dev","14px serif",[0,"#000000"],0],\n [2,739,2505.2,86.0004,18.5,0,[0,"#000000"]],\n [3,739,2508.9,"libgd2-xpm-dev","14px serif",[0,"#000000"],0],\n [2,739,3037.17,63,18.5,0,[0,"#000000"]],\n [3,739,3040.87,"librdf0-dev","14px serif",[0,"#000000"],0],\n [2,739,3160.17,63,18.5,0,[0,"#000000"]],\n [3,739,3163.87,"librpm-dev","14px serif",[0,"#000000"],0],\n [2,1334,2177.2,88.9992,18.5,0,[0,"#000000"]],\n [3,1334,2180.9,"ubuntu-desktop","14px serif",[0,"#000000"],0],\n [2,1334,2379.2,90,18.5,0,[0,"#000000"]],\n [3,1334,2382.9,"ubuntu-netbook","14px serif",[0,"#000000"],0],\n [0,[0,[0,303.12,3900.17],[1,393.26,3900.17,507.79,3900.17,596.83,3900.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,213.13,3824.17],[1,324.93,3824.17,568.72,3824.17,680.67,3824.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,214.75,3749.17],[1,326.82,3749.17,567.33,3749.17,679.33,3749.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,235.59,3673.17],[1,361.22,3673.17,599.38,3673.17,696.33,3673.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,275.3,3598.17],[1,346.08,3598.17,437.75,3598.17,520.87,3598.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,260.76,3522.17],[1,366.27,3522.17,527.46,3522.17,633.04,3522.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,262.11,3447.17],[1,367.16,3447.17,526.43,3447.17,631.58,3447.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,2465.1,2121.2],[1,2564.3,2121.2,2709.7,2121.2,2763.2,2121.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,2439.8,2182.9],[1,2538,2165.3,2706,2135.2,2763.8,2124.8]],0,\n [0,"#ff0000"]],\n [0,\n [0,[0,2428.2,2257.6],[1,2463.5,2248.9,2508.1,2236.7,2547,2223.2],\n [1,2630.5,2194.1,2726.2,2149.2,2765.6,2130.2]],\n 0,[0,"#ff0000"]],\n [0,\n [0,[0,2429.1,1984.4],[1,2464.2,1993,2508.5,2004.8,2547,2018.2],\n [1,2630.7,2047.3,2726.3,2092.8,2765.6,2112.1]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,2447.1,2059.9],[1,2546.1,2077.9,2707.3,2107.2,2763.7,2117.5]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1424.2,3007.17],[1,1507.8,3007.17,1632.8,3007.17,1723.9,3007.17]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,245.29,2430.2],[1,354.95,2430.2,538.82,2430.2,648.55,2430.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,247.54,2354.2],[1,358.01,2354.2,541.46,2354.2,650.24,2354.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,236.51,2279.2],[1,337.2,2279.2,509.15,2279.2,623.42,2279.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1949.6,2662.2],[1,2053.5,2662.2,2206.4,2662.2,2295.2,2662.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,268.29,2203.2],[1,385.38,2203.2,564.77,2203.2,664.89,2203.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,230.75,2128.2],[1,342.47,2128.2,550.28,2128.2,662.46,2128.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,233.76,2052.2],[1,335.49,2052.2,513.15,2052.2,628.39,2052.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1445,1877.6],[1,1523.6,1877.9,1629.1,1878.3,1711.3,1878.7]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1889.5,2557.3],[1,1988.5,2529.4,2210.1,2467.1,2312.4,2438.3]],0,\n [0,"#ff0000"]],\n [0,[0,[0,236.51,1642.2],[1,352.41,1642.2,562.73,1642.2,670.83,1642.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,255.73,1567.2],[1,362.75,1567.2,530.98,1567.2,638.08,1567.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1414.2,3199.47],[1,1508.8,3211.63,1665.2,3231.71,1759.8,3243.87]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,1968.7,2837.2],[1,2057.3,2837.2,2173.8,2837.2,2257.7,2837.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1407,1720.7],[1,1525,1742.7,1751.2,1784.7,1819.8,1797.4]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1495.1,1801.9],[1,1614.3,1801.6,1765,1801.3,1819.3,1801.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1384.4,1956.1],[1,1493.6,1918.9,1748.3,1832.3,1820.6,1807.8]],0,\n [0,"#ff0000"]],\n [0,[0,[0,274.59,1491.2],[1,375.29,1491.2,518.6,1491.2,619.32,1491.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,257.73,1416.2],[1,364.26,1416.2,529.85,1416.2,636.36,1416.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,235.28,1340.2],[1,348.31,1340.2,552.84,1340.2,663.31,1340.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,245.29,1265.2],[1,365.99,1265.2,576.62,1265.2,679.3,1265.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,264.5,1189.2],[1,365.73,1189.2,515.8,1189.2,619.97,1189.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,190.65,1114.2],[1,281.11,1114.2,521.56,1114.2,651.97,1114.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,189.35,812.2],[1,278.29,812.2,518.28,812.2,649.81,812.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,187.23,818.5],[1,293.76,839.3,632.65,905.4,718.88,922.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,237.43,892.7],[1,374.68,901.8,642.46,919.7,718.45,924.8]],0,\n [0,"#ff0000"]],\n [0,[0,[0,249.8,957.2],[1,390.15,948.3,644.6,932.2,718.41,927.5]],0,\n [0,"#ff0000"]],\n [0,[0,[0,197.94,1029.9],[1,314.77,1007.5,635.17,946.1,718.81,930]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1894.8,2252.2],[1,1988,2271,2177.5,2309.2,2285.7,2331]],0,\n [0,"#ff0000"]],\n [0,[0,[0,184.36,736.2],[1,278.73,736.2,574.9,736.2,691.32,736.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,262.45,649.2],[1,368.7,637.4,530.17,619.4,635.14,607.7]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1939.6,631.2],[1,2043.6,631.2,2204.3,631.2,2295.9,631.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,209.68,521.2],[1,314.17,521.2,542.44,521.2,662.19,521.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,242.12,445.2],[1,356.9,445.2,556.84,445.2,664.79,445.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,256.06,232.2],[1,397.74,250.3,646.23,282.3,718.65,291.6]],0,\n [0,"#ff0000"]],\n [0,[0,[0,297.12,294.2],[1,441.28,294.2,652.33,294.2,718.43,294.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,256.73,356.9],[1,398.39,338.5,645.89,306.3,718.46,296.8]],0,\n [0,"#ff0000"]],\n [0,[0,[0,247.86,3317.35],[1,355.35,3329.13,531.6,3348.45,641.17,3360.45]],\n 0,[0,"#ff0000"]],\n [0,[0,[0,1415.9,42.5],[1,1535.9,60.5,1752.5,93,1819.6,103.1]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1479.3,106.2],[1,1600.5,106.2,1762.2,106.2,1819.1,106.2]],0,\n [0,"#ff0000"]],\n [0,[0,[0,1418.7,168.6],[1,1539.1,150.8,1752.6,119.1,1819.4,109.2]],0,\n [0,"#ff0000"]],\n [1,\n [0,[0,1733.6,3257.52],[0,1733.49,3254.02],[0,1743.59,3257.2],\n [0,1733.71,3261.02]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,265.56,3303.7],[1,572.42,3294.04,1431.9,3267.01,1733.6,3257.52]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,1769.4,3270.6],[0,1768.63,3267.19],[0,1779.16,3268.4],\n [0,1770.17,3274.01]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,858.61,3367.91],[1,1008,3362.76,1271.3,3350.18,1495,3321.17],\n [1,1590.7,3308.76,1699.9,3286.1,1769.4,3270.6]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,1193.9,114.9],[0,1193.66,111.408],[0,1203.88,114.222],\n [0,1194.14,118.392]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,761.24,141.8],[1,830.72,137.5,1047.8,124,1193.9,114.9]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1214.8,173.6],[0,1215,170.106],[0,1224.78,174.182],\n [0,1214.6,177.094]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,761.24,144.6],[1,834.12,149.2,1069.4,164.3,1214.8,173.6]],0,\n [0,"#0000ff"]],\n [1,[0,[0,706.75,143.2],[0,706.75,139.7],[0,716.75,143.2],[0,706.75,146.7]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,234.06,143.2],[1,364.02,143.2,617.28,143.2,706.75,143.2]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1730.5,633.1],[0,1730.43,629.601],[0,1740.5,632.904],\n [0,1730.57,636.599]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,297.21,658.6],[1,626.54,652.8,1435.9,638.4,1730.5,633.1]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1731.6,627.7],[0,1731.7,624.202],[0,1741.6,627.997],\n [0,1731.5,631.198]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,870.44,600.4],[1,1090.2,607.3,1528.2,621.3,1731.6,627.7]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1232.6,1865.6],[0,1233.01,1862.12],[0,1242.53,1866.78],\n [0,1232.19,1869.08]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,251.48,1754.1],[1,471.39,1779.1,1008.1,1840.1,1232.6,1865.6]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1215.1,1710.8],[0,1215,1707.3],[0,1225.1,1710.51],[0,1215.2,1714.3]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,274.26,1739.5],[1,500.42,1732.6,989.15,1717.7,1215.1,1710.8]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1165.7,1805.9],[0,1165.63,1802.4],[0,1175.7,1805.7],\n [0,1165.77,1809.4]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,299.27,1825],[1,518.19,1820.2,933.33,1811,1165.7,1805.9]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1216,1872.3],[0,1216.14,1868.8],[0,1225.99,1872.69],\n [0,1215.86,1875.8]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,294,1834],[1,528.11,1843.7,996.91,1863.2,1216,1872.3]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1163.8,1970.7],[0,1163.87,1967.2],[0,1173.8,1970.9],\n [0,1163.73,1974.2]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,300.75,1958.3],[1,519.45,1961.4,931.55,1967.4,1163.8,1970.7]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1220.8,1884.8],[0,1220.56,1881.31],[0,1230.78,1884.12],\n [0,1221.04,1888.29]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,283.7,1947.6],[1,515.75,1932,1000.55,1899.5,1220.8,1884.8]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1723.3,2666.6],[0,1723.16,2663.1],[0,1733.29,2666.2],\n [0,1723.44,2670.1]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,809.13,2701.5],[1,993.71,2694.5,1494.5,2675.4,1723.3,2666.6]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1732.3,2824.2],[0,1732.71,2820.72],[0,1742.23,2825.37],\n [0,1731.89,2827.68]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,802.95,2711.9],[1,984.66,2733.8,1505.4,2796.8,1732.3,2824.2]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1701.2,2837.2],[0,1701.2,2833.7],[0,1711.2,2837.2],\n [0,1701.2,2840.7]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,829.57,2837.2],[1,1021.9,2837.2,1472.3,2837.2,1701.2,2837.2]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1747.4,2992.88],[0,1747.93,2989.42],[0,1757.28,2994.4],\n [0,1746.87,2996.34]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,810.81,2848.3],[1,1003.63,2878,1532.6,2959.7,1747.4,2992.88]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1751.1,2676.3],[0,1750.54,2672.84],[0,1760.97,2674.7],\n [0,1751.66,2679.76]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,809.97,2825.9],[1,1003.19,2795.2,1538.4,2710.1,1751.1,2676.3]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1752,2572.3],[0,1751.96,2568.8],[0,1762,2572.2],[0,1752.04,2575.8]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,838.16,2583.9],[1,1051.2,2581.2,1549.4,2574.9,1752,2572.3]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1728.7,2654.4],[0,1728.94,2650.91],[0,1738.68,2655.08],\n [0,1728.46,2657.89]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,831.45,2591.6],[1,1033,2605.7,1511.2,2639.2,1728.7,2654.4]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,2261.7,2428.4],[0,2261.53,2424.9],[0,2271.69,2427.91],\n [0,2261.87,2431.9]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,823.33,2500.9],[1,1097.2,2487.1,1961.2,2443.6,2261.7,2428.4]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1747.7,2648.7],[0,1748.21,2645.24],[0,1757.59,2650.17],\n [0,1747.19,2652.16]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,810.94,2515.3],[1,945.34,2534.2,1243.7,2576.2,1495,2612.2],\n [1,1580.7,2624.4,1678.2,2638.6,1747.7,2648.7]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,1751.6,2853.2],[0,1750.97,2849.76],[0,1761.44,2851.41],\n [0,1752.23,2856.64]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,792.48,3027.46],[1,968.7,2995.45,1532.4,2893.1,1751.6,2853.2]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,1778.9,3235.95],[0,1779.88,3232.59],[0,1788.5,3238.75],\n [0,1777.92,3239.31]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,796.74,3044.78],[1,923.72,3061.92,1236.5,3106.48,1495,3162.17],\n [1,1595.4,3183.8,1710.2,3215.94,1778.9,3235.95]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,1733.9,3250.47],[0,1734.04,3246.97],[0,1743.89,3250.86],\n [0,1733.76,3253.97]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,794.69,3168.66],[1,877.15,3180.92,1036.6,3203.51,1173,3216.17],\n [1,1370.7,3234.53,1602.2,3245.33,1733.9,3250.47]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,1743.2,3020.62],[0,1742.72,3017.15],[0,1753.11,3019.25],\n [0,1743.68,3024.09]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,795.88,3152.27],[1,973.57,3127.58,1519.8,3051.67,1743.2,3020.62]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,2295.7,2406.6],[0,2296.5,2403.19],[0,2305.44,2408.88],\n [0,2294.9,2410.01]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,1391.1,2191.1],[1,1465,2209,1597.5,2241.1,1711,2268.2],\n [1,1923.8,2319,2175.7,2378.4,2295.7,2406.6]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,2285.7,2328],[0,2286.57,2324.61],[0,2295.38,2330.49],\n [0,2284.83,2331.39]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,\n [0,[0,1421.5,2173.6],[1,1545,2170.5,1777,2171.9,1969,2214.2],\n [1,2069.8,2236.3,2087,2267,2185,2299.2],\n [1,2217.6,2309.9,2254.1,2319.9,2285.7,2328]],\n 0,[0,"#0000ff"]],\n [1,\n [0,[0,2256.4,2059.2],[0,2255.96,2055.73],[0,2266.32,2057.94],\n [0,2256.84,2062.67]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,1409.5,2167.5],[1,1589.7,2144.5,2045.9,2086.1,2256.4,2059.2]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,2260.5,2418.7],[0,2260.64,2415.2],[0,2270.49,2419.1],\n [0,2260.36,2422.2]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,1422.9,2383],[1,1612.7,2391.1,2056.8,2410,2260.5,2418.7]],0,\n [0,"#0000ff"]],\n [1,\n [0,[0,2182.7,2352.9],[0,2182.56,2349.4],[0,2192.69,2352.5],\n [0,2182.84,2356.4]],\n [0,"#0000ff"],[0,"#0000ff"]],\n [0,[0,[0,1423.8,2376.4],[1,1592.5,2371.2,1959.7,2359.8,2182.7,2352.9]],0,\n [0,"#0000ff"]]]]\n');var
+a7=[0,e("Failure")],dC=[0,e("Invalid_argument")],I=[0,e("Not_found")],d0=[0,e("Match_failure")],dZ=[0,e("Stack_overflow")],r=[0,e("Assert_failure")],d1=[0,e("Undefined_recursive_module")],bR=e('File "%s", line %d, characters %d-%d: %s'),c2=[0,0,0,0,0],db=e("scene.json"),aS=[0,e(fu),e(fb),e(fp),e(fr),e(e_),e(fk),e(fy),e(fh)],eG=[0,e("_value"),e("_lower"),e("_upper"),e("_step_incr"),e("_page_incr"),e("_page_size")],eH=[0,e(fh),e(fy),e(fp),e(fu),e(fb),e(fk),e(fr),e(e_)];W(11,d1);W(8,dZ);W(7,d0);W(6,I);W(5,[0,e("Division_by_zero")]);W(4,[0,e("End_of_file")]);W(3,dC);W(2,a7);W(1,[0,e("Sys_error")]);var
+gS=[0,e("Out_of_memory")],fY=e(fg),fX=e(ax),fV=e("true"),fW=e("false"),fZ=e("Pervasives.do_at_exit"),f1=e("Array.blit"),f6=e("\\b"),f7=e("\\t"),f8=e("\\n"),f9=e("\\r"),f5=e("\\\\"),f4=e("\\'"),ga=e(g),f$=e("String.blit"),f_=e("String.sub"),gf=e("Map.remove_min_elt"),gg=[0,0,0,0],gh=[0,e("map.ml"),270,10],gi=[0,0,0],gb=e(bE),gc=e(bE),gd=e(bE),ge=e(bE),gj=e("Queue.Empty"),gl=e("Buffer.add: cannot grow buffer"),gB=e(g),gC=e(g),gF=e(fg),gG=e(fe),gH=e(fe),gD=e(bv),gE=e(bv),gA=e(fi),gy=e("neg_infinity"),gz=e("infinity"),gx=e(ax),gw=e("printf: bad positional specification (0)."),gv=e("%_"),gu=[0,e("printf.ml"),143,8],gs=e(bv),gt=e("Printf: premature end of format string '"),go=e(bv),gp=e(" in format string '"),gq=e(", at char number "),gr=e("Printf: bad conversion %"),gm=e("Sformat.index_of_int: negative argument "),gM=e(g),gN=e(", %s%s"),g4=[1,1],g5=e("%s\n"),g6=e("(Program not linked with -g, cannot print stack backtrace)\n"),gY=e("Raised at"),g1=e("Re-raised at"),g2=e("Raised by primitive operation at"),g3=e("Called from"),gZ=e('%s file "%s", line %d, characters %d-%d'),g0=e("%s unknown location"),gT=e("Out of memory"),gU=e("Stack overflow"),gV=e("Pattern matching failed"),gW=e("Assertion failed"),gX=e("Undefined recursive module"),gO=e("(%s%s)"),gP=e(g),gQ=e(g),gR=e("(%s)"),gL=e(fa),gJ=e("%S"),gK=e("_"),ha=e(g),g7=e("CamlinternalOO.last_id"),hs=[0,e(ay),670,20],ht=[0,e(ay),673,8],hq=[0,e(ay),648,20],hr=[0,e(ay),651,8],hn=[0,e(ay),498,8],hm=[0,e(ay),487,9],hl=e("Lwt.wakeup_result"),hi=e("Fatal error: exception "),hh=e("Lwt.Canceled"),ho=[0,0],hz=e("Js.Error"),hA=e(fc),hO=e("canvas"),hL=e("p"),hK=e("div"),hB=e("mouseup"),hD=e("mousemove"),hF=e("mousewheel"),hH=e("DOMMouseScroll"),hM=e("Dom_html.Canvas_not_available"),hT=e("browser can't read file: unimplemented"),hS=[0,e("file.ml"),131,15],hQ=e("can't retrieve file name: not implemented"),hW=e("Exception during Lwt.async: "),hY=e("[\\][()\\\\|+*.?{}^$]"),h$=[0,e(g),0],ia=e(g),ip=e(g),iq=e(bw),iy=e(g),ir=e(bs),ix=e(g),is=e($),it=e($),iw=e(e1),iu=e(g),iv=e("http://"),iz=e(g),iA=e(bw),iI=e(g),iB=e(bs),iH=e(g),iC=e($),iD=e($),iG=e(e1),iE=e(g),iF=e("https://"),iJ=e(g),iK=e(bw),iP=e(g),iL=e(bs),iO=e(g),iM=e($),iN=e("file://"),io=e(g),im=e(g),il=e(g),ik=e(g),ij=e(g),ii=e(g),ib=e(dr),ic=e(fA),h5=e("file"),h6=e("file:"),h7=e("http"),h8=e("http:"),h9=e("https"),h_=e("https:"),h2=e("%2B"),h0=e("Url.Local_exn"),h1=e(aX),h3=e("Url.Not_an_http_protocol"),id=e("^([Hh][Tt][Tt][Pp][Ss]?)://([0-9a-zA-Z.-]+|\\[[0-9a-zA-Z.-]+\\]|\\[[0-9A-Fa-f:.]+\\])?(:([0-9]+))?/([^\\?#]*)(\\?([^#]*))?(#(.*))?$"),ig=e("^([Ff][Ii][Ll][Ee])://([^\\?#]*)(\\?([^#]*))?(#(.*))?$"),i6=e(bD),i8=e("multipart/form-data; boundary="),i9=e(bD),i_=[0,e(bD),[0,e("application/x-www-form-urlencoded")],bC],i$=[0,e(bD),0,bC],ja=e("GET"),i7=e(bs),i1=e(dr),i2=e(dr),i3=e(fA),iX=e('"; filename="'),iY=e(fo),iV=e(bz),iW=e(e7),iZ=e('"\r\n\r\n'),i0=e(fo),iT=e("--\r\n"),iU=e(e7),iS=e("js_of_ocaml-------------------"),iR=[0,e("xmlHttpRequest.ml"),79,2],i4=e("XmlHttpRequest.Wrong_headers"),jd=[0,0,0],jg=[0,e(aV),260,8],jh=[0,e(aV),263,8],je=[0,e(aV),269,6],jf=[0,e(aV),272,6],jc=[0,e(aV),e6,63],jE=e("%dpx"),jA=[0,0],jB=[0,0],jC=[0,1],jD=[0,20],jj=[0,e("viewer_js.ml"),90,26];function
+aB(a){throw[0,a7,a]}function
+H(a){throw[0,dC,a]}function
+an(a,b){return kc(a,b)?a:b}function
+ao(a,b){return jU(a,b)?a:b}function
+j(a,b){var
+c=a.getLen(),e=b.getLen(),d=X(c+e|0);ag(a,0,d,0,c);ag(b,0,d,c,e);return d}function
+ap(a){return e(g+a)}function
+dD(a,b){if(a){var
+c=a[1];return[0,c,dD(a[2],b)]}return b}ke(0);eS(1);var
+aC=eS(2);function
+dE(a,b){return fN(a,b,0,b.getLen())}function
+dF(a){return dE(aC,a)}function
+bK(a){var
+b=kg(0);for(;;){if(b){var
+c=b[2],d=b[1];try{eT(d)}catch(f){}var
+b=c;continue}return 0}}dc(fZ,bK);function
+f0(a,b){return eU(a,b)}function
+dG(a){return eT(a)}function
+dJ(a,b){var
+d=b.length-1-1|0,e=0;if(!(d<0)){var
+c=e;for(;;){i(a,c,b[c+1]);var
+f=c+1|0;if(d!==c){var
+c=f;continue}break}}return 0}function
+a8(a){var
+b=a,c=0;for(;;){if(b){var
+d=[0,b[1],c],b=b[2],c=d;continue}return c}}function
+aq(a,b){if(b){var
+c=b[2],d=h(a,b[1]);return[0,d,aq(a,c)]}return 0}function
+aE(a,b){var
+c=b;for(;;){if(c){var
+d=c[2];h(a,c[1]);var
+c=d;continue}return 0}}function
+aF(a,b){var
+c=X(a);jO(c,0,a,b);return c}function
+aa(a,b,c){if(0<=b)if(0<=c)if(!((a.getLen()-c|0)>1,b);return c+c}function
+B(a){if(a!=null){this.bytes=this.fullBytes=a;this.last=this.len=a.length}}function
+fW(){fV(u[4],new
+B(fx))}B.prototype={string:null,bytes:null,fullBytes:null,array:null,len:null,last:0,toJsString:function(){var
+a=this.getFullBytes();try{return this.string=decodeURIComponent(escape(a))}catch(f){dk('MlString.toJsString: wrong encoding for "%s" ',a);return a}},toBytes:function(){if(this.string!=null)try{var
+a=unescape(encodeURIComponent(this.string))}catch(f){dk('MlString.toBytes: wrong encoding for "%s" ',this.string);var
+a=this.string}else{var
+a=d,c=this.array,e=c.length;for(var
+b=0;b=0;e--)b[c+e]=g[a+e];else{var
+f=this.bytes;if(f==null)f=this.toBytes();var
+h=this.last-a;if(d<=h)for(var
+e=0;e=this.len)fW();return this.get(a)},set:function(a,b){var
+c=this.array;if(!c){if(this.last==a){this.bytes+=String.fromCharCode(b&v);this.last++;return 0}c=this.toArray()}else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;c[a]=b&v;return 0},safeSet:function(a,b){if(this.len==null)this.toBytes();if(a<0||a>=this.len)fW();this.set(a,b)},fill:function(a,b,c){if(a>=this.last&&this.last&&c==0)return;var
+d=this.array;if(!d)d=this.toArray();else
+if(this.bytes!=null)this.bytes=this.fullBytes=this.string=null;var
+f=a+b;for(var
+e=a;ea.string)return 1;return 0}var
+b=this.getFullBytes(),c=a.getFullBytes();if(bc)return 1;return 0},equal:function(a){if(this.string!=null&&a.string!=null)return this.string==a.string;return this.getFullBytes()==a.getFullBytes()},lessThan:function(a){if(this.string!=null&&a.string!=null)return this.string=a.length-1)fG();return a[b+1]}function
+j7(a,b,c){if(b<0||b>=a.length-1)fG();a[b+1]=c;return 0}function
+j8(a,b,c){return[0].concat(a.slice(b+1,b+1+c))}function
+fH(a,b,c,d,e){if(e===0)return;if(d===c.last&&c.bytes!=null){var
+f=a.bytes;if(f==null)f=a.toBytes();if(b>0||a.last>e)f=f.slice(b,b+e);c.bytes+=f;c.last+=f.length;return}var
+g=c.array;if(!g)g=c.toArray();else
+c.bytes=c.string=null;a.blitToArray(b,g,d,e)}function
+ar(c,b){if(c.fun)return ar(c.fun,b);var
+a=c.length,d=a-b.length;if(d==0)return c.apply(null,b);else
+if(d<0)return ar(c.apply(null,b.slice(0,a)),b.slice(a));else
+return function(a){return ar(c,b.concat([a]))}}function
+j9(a){if(isFinite(a)){if(Math.abs(a)>=2.22507385850720138e-308)return 0;if(a!=0)return 1;return 2}return isNaN(a)?4:3}function
+kk(a,b){var
+c=a[3]<<16,d=b[3]<<16;if(c>d)return 1;if(cb[2])return 1;if(a[2]b[1])return 1;if(a[1]1)e.push(a,b,1)}}else
+return 1}else
+if(b
+instanceof
+B||b
+instanceof
+Array&&b[0]===(b[0]|0))return-1;else
+if(typeof
+a!=A&&a&&a.compare)return a.compare(b,c);else{if(ab)return 1;if(a!=b){if(!c)return NaN;if(a==a)return 1;if(b==b)return-1}}if(e.length==0)return 0;var
+h=e.pop();b=e.pop();a=e.pop();if(h+131)aT("format_int: format too long");var
+b={justify:bf,signstyle:aD,filler:Y,alternate:false,base:0,signedconv:false,width:0,uppercase:false,sign:1,prec:-1,conv:c5};for(var
+d=0;d=0&&c<=9){b.width=b.width*10+c;d++}d--;break;case
+aR:b.prec=0;d++;while(c=a.charCodeAt(d)-48,c>=0&&c<=9){b.prec=b.prec*10+c;d++}d--;case"d":case"i":b.signedconv=true;case"u":b.base=10;break;case
+c9:b.base=16;break;case"X":b.base=16;b.uppercase=true;break;case"o":b.base=8;break;case
+bj:case
+c5:case
+bd:b.signedconv=true;b.conv=c;break;case"E":case"F":case"G":b.signedconv=true;b.uppercase=true;b.conv=c.toLowerCase();break}}return b}function
+dh(a,b){if(a.uppercase)b=b.toUpperCase();var
+g=b.length;if(a.signedconv&&(a.sign<0||a.signstyle!=aD))g++;if(a.alternate){if(a.base==8)g+=1;if(a.base==16)g+=2}var
+c=d;if(a.justify==bf&&a.filler==Y)for(var
+e=g;ee){var
+d=j-1;while(c.charAt(d)==f)d--;if(c.charAt(d)==aR)d--;c=c.slice(0,d+1)+c.slice(j);d=c.length;if(c.charAt(d-3)==bj)c=c.slice(0,d-1)+f+c.slice(d-1);break}else{var
+h=e;if(i<0){h-=i+1;c=b.toFixed(h)}else
+while(c=b.toFixed(h),c.length>e+1)h--;if(h){var
+d=c.length-1;while(c.charAt(d)==f)d--;if(c.charAt(d)==aR)d--;c=c.slice(0,d+1)}}break}return dh(g,c)}function
+ke(a,b){if(a.toString()==fq)return new
+x(d+b);var
+c=di(a);if(b<0)if(c.signedconv){c.sign=-1;b=-b}else
+b>>>=0;var
+e=b.toString(c.base);if(c.prec>=0){c.filler=Y;var
+g=c.prec-e.length;if(g>0)e=bo(g,f)+e}return dh(c,e)}function
+fS(a){throw[0,a]}function
+fU(){fS(u[7])}function
+dg(a){var
+b=a.length;this.array=a;this.len=this.last=b}dg.prototype=new
+B();function
+aG(){this.content={}}aG.prototype={exists:function(a){return this.content[a]?1:0},mk:function(a,b){this.content[a]=b},get:function(a){return this.content[a]},list:function(){var
+a=[];for(var
+b
+in
+this.content)a.push(b);return a},remove:function(a){delete
+this.content[a]}};var
+cd=new
+aG();cd.mk(d,new
+aG());function
+R(a){dj(u[2],a)}function
+fT(a){a=a
+instanceof
+B?a.toString():a;R(a+": No such file or directory")}function
+ca(a){var
+b=cd;for(var
+c=0;c1)b.pop();break;case
+aR:case
+d:if(b.length==0)b.push(d);break;default:b.push(e[c]);break}b.orig=a;return b}function
+aS(a){this.data=a}aS.prototype={content:function(){return this.data},truncate:function(){this.data.length=0}};function
+kf(a){var
+c=bm(a),b=ca(c);if(b
+instanceof
+aS)return new
+dg(b.content());fU()}function
+fJ(a,b){var
+e=bm(a),c=cd;for(var
+f=0;f=0)}function
+fK(a){if(!isFinite(a)){if(isNaN(a))return[v,1,0,ft];return a>0?[v,0,0,32752]:[v,0,0,ft]}var
+f=a>=0?0:32768;if(f)a=-a;var
+b=Math.floor(Math.LOG2E*Math.log(a))+1023;if(b<=0){b=0;a/=Math.pow(2,-1026)}else{a/=Math.pow(2,b-1027);if(a<16){a*=2;b-=1}if(b==0)a/=2}var
+d=Math.pow(2,24),c=a|0;a=(a-c)*d;var
+e=a|0;a=(a-e)*d;var
+g=a|0;c=c&15|f|b<<4;return[v,g,e,c]}if(!Math.imul)Math.imul=function(a,b){return((a>>16)*b<<16)+(a&b4)*b|0};var
+bn=Math.imul,ki=function(){var
+p=256;function
+c(a,b){return a<>>32-b}function
+g(a,b){b=bn(b,3432918353);b=c(b,15);b=bn(b,461845907);a^=b;a=c(a,13);return(a*5|0)+3864292196|0}function
+s(a){a^=a>>>16;a=bn(a,2246822507);a^=a>>>13;a=bn(a,3266489909);a^=a>>>16;return a}function
+t(a,b){var
+d=b[1]|b[2]<<24,c=b[2]>>>8|b[3]<<16;a=g(a,d);a=g(a,c);return a}function
+u(a,b){var
+d=b[1]|b[2]<<24,c=b[2]>>>8|b[3]<<16;a=g(a,c^d);return a}function
+x(a,b){var
+e=b.length,c,d;for(c=0;c+4<=e;c+=4){d=b.charCodeAt(c)|b.charCodeAt(c+1)<<8|b.charCodeAt(c+2)<<16|b.charCodeAt(c+3)<<24;a=g(a,d)}d=0;switch(e&3){case
+3:d=b.charCodeAt(c+2)<<16;case
+2:d|=b.charCodeAt(c+1)<<8;case
+1:d|=b.charCodeAt(c);a=g(a,d)}a^=e;return a}function
+w(a,b){var
+e=b.length,c,d;for(c=0;c+4<=e;c+=4){d=b[c]|b[c+1]<<8|b[c+2]<<16|b[c+3]<<24;a=g(a,d)}d=0;switch(e&3){case
+3:d=b[c+2]<<16;case
+2:d|=b[c+1]<<8;case
+1:d|=b[c];a=g(a,d)}a^=e;return a}return function(a,b,c,d){var
+k,l,m,i,h,f,e,j,o;i=b;if(i<0||i>p)i=p;h=a;f=c;k=[d];l=0;m=1;while(l0){e=k[l++];if(e
+instanceof
+Array&&e[0]===(e[0]|0))switch(e[0]){case
+c1:f=g(f,e[2]);h--;break;case
+Z:k[--l]=e[1];break;case
+v:f=u(f,e);h--;break;default:var
+r=e.length-1<<10|e[0];f=g(f,r);for(j=1,o=e.length;j=i)break;k[m++]=e[j]}break}else
+if(e
+instanceof
+B){var
+n=e.array;if(n)f=w(f,n);else{var
+q=e.getFullBytes();f=x(f,q)}h--;break}else
+if(e===(e|0)){f=g(f,e+e+1);h--}else
+if(e===+e){f=t(f,fK(e));h--;break}}f=s(f);return f&bV}}();function
+ks(a){return[a[3]>>8,a[3]&v,a[2]>>16,a[2]>>8&v,a[2]&v,a[1]>>16,a[1]>>8&v,a[1]&v]}function
+kj(e,b,c){var
+d=0;function
+f(a){b--;if(e<0||b<0)return;if(a
+instanceof
+Array&&a[0]===(a[0]|0))switch(a[0]){case
+c1:e--;d=d*c2+a[2]|0;break;case
+Z:b++;f(a);break;case
+v:e--;d=d*c2+a[1]+(a[2]<<24)|0;break;default:e--;d=d*19+a[0]|0;for(var
+c=a.length-1;c>0;c--)f(a[c])}else
+if(a
+instanceof
+B){e--;var
+g=a.array,h=a.getLen();if(g)for(var
+c=0;c=0;c--)d=d*19+j[c]|0}}f(c);return d&bV}function
+kn(a){return(a[3]|a[2]|a[1])==0}function
+kq(a){return[v,a&_,a>>24&_,a>>31&b4]}function
+kr(a,b){var
+c=a[1]-b[1],d=a[2]-b[2]+(c>>24),e=a[3]-b[3]+(d>>24);return[v,c&_,d&_,e&b4]}function
+fM(a,b){if(a[3]>b[3])return 1;if(a[3]b[2])return 1;if(a[2]b[1])return 1;if(a[1]>23;a[2]=(a[2]<<1|a[1]>>23)&_;a[1]=a[1]<<1&_}function
+ko(a){a[1]=(a[1]>>>1|a[2]<<23)&_;a[2]=(a[2]>>>1|a[3]<<23)&_;a[3]=a[3]>>>1}function
+ku(a,b){var
+e=0,d=a.slice(),c=b.slice(),f=[v,0,0,0];while(fM(d,c)>0){e++;fL(c)}while(e>=0){e--;fL(f);if(fM(d,c)>=0){f[1]++;d=kr(d,c)}ko(c)}return[0,f,d]}function
+kt(a){return a[1]|a[2]<<24}function
+km(a){return a[3]<<16<0}function
+kp(a){var
+b=-a[1],c=-a[2]+(b>>24),d=-a[3]+(c>>24);return[v,b&_,c&_,d&b4]}function
+kl(a,b){var
+c=di(a);if(c.signedconv&&km(b)){c.sign=-1;b=kp(b)}var
+e=d,j=kq(c.base),i="0123456789abcdef";do{var
+h=ku(b,j);b=h[1];e=i.charAt(kt(h[2]))+e}while(!kn(b));if(c.prec>=0){c.filler=Y;var
+g=c.prec-e.length;if(g>0)e=bo(g,f)+e}return dh(c,e)}function
+kT(a){var
+b=0,c=10,d=a.get(0)==45?(b++,-1):1;if(a.get(b)==48)switch(a.get(b+1)){case
+c$:case
+88:c=16;b+=2;break;case
+cX:case
+79:c=8;b+=2;break;case
+98:case
+66:c=2;b+=2;break}return[b,d,c]}function
+fR(a){if(a>=48&&a<=57)return a-48;if(a>=65&&a<=90)return a-55;if(a>=97&&a<=122)return a-87;return-1}function
+kw(a){var
+g=kT(a),f=g[0],h=g[1],d=g[2],i=-1>>>0,e=a.get(f),c=fR(e);if(c<0||c>=d)b$(bU);var
+b=c;for(;;){f++;e=a.get(f);if(e==95)continue;c=fR(e);if(c<0||c>=d)break;b=d*b+c;if(b>i)b$(bU)}if(f!=a.getLen())b$(bU);b=h*b;if(d==10&&(b|0)!=b)b$(bU);return b|0}function
+kx(a){return+(a>31&&a<127)}function
+ky(a,b,c){return a.apply(b,c.slice(1))}function
+kz(a){return a.getFullBytes()}function
+kA(){var
+c=b.console?b.console:{},d=["log","debug","info","warn","error","assert","dir","dirxml","trace","group","groupCollapsed","groupEnd","time","timeEnd"];function
+e(){}for(var
+a=0;a0?c.call(arguments):[undefined];return ar(a,b)}}function
+kG(a,b){return+(bl(a,b,false)<=0)}function
+kH(a,b){var
+d=[0];for(var
+c=1;c<=a;c++)d[c]=b;return d}var
+kI=function(){function
+m(a,b){return a+b|0}function
+l(a,b,c,d,e,f){b=m(m(b,a),m(d,f));return m(b<>>32-e,c)}function
+h(a,b,c,d,e,f,g){return l(b&c|~b&d,a,b,e,f,g)}function
+i(a,b,c,d,e,f,g){return l(b&d|c&~d,a,b,e,f,g)}function
+j(a,b,c,d,e,f,g){return l(b^c^d,a,b,e,f,g)}function
+k(a,b,c,d,e,f,g){return l(c^(b|~d),a,b,e,f,g)}function
+n(a,b){var
+g=b;a[g>>2]|=128<<8*(g&3);for(g=(g&~3)+8;(g&63)<60;g+=4)a[(g>>2)-1]=0;a[(g>>2)-1]=b<<3;a[g>>2]=b>>29&536870911;var
+l=[1732584193,4023233417,2562383102,271733878];for(g=0;g>8*n&v;return o}return function(a,b,c){var
+h=[];if(a.array){var
+f=a.array;for(var
+d=0;d>2]=f[e]|f[e+1]<<8|f[e+2]<<16|f[e+3]<<24}for(;d>2]|=f[d+b]<<8*(d&3)}else{var
+g=a.getFullBytes();for(var
+d=0;d>2]=g.charCodeAt(e)|g.charCodeAt(e+1)<<8|g.charCodeAt(e+2)<<16|g.charCodeAt(e+3)<<24}for(;d>2]|=g.charCodeAt(d+b)<<8*(d&3)}return new
+dg(n(h,c))}}();function
+fN(a){if(!a.opened)R("Cannot flush a closed channel");if(a.buffer==d)return 0;if(a.output)switch(a.output.length){case
+2:a.output(a,a.buffer);break;default:a.output(a.buffer)}a.buffer=d}function
+k4(a){var
+c=bm(a),b=ca(c);return b
+instanceof
+aG?1:0}function
+k2(a){var
+b=cd,d=bm(a),e;for(var
+c=0;cGFDL or CC-BY-SA-3.0]",800,489,[0,[0,"Ovibovini","fr",""],[0,"B\xc5\x93uf musqu\xc3\xa9","fr","B%C5%93uf_musqu%C3%A9"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ec/Ovibos_moschatus_attackierend2_.jpg/800px-Ovibos_moschatus_attackierend2_.jpg"]],[0,"capra","Saanenziege.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0 or CC-BY-SA-2.5-2.0-1.0]",332,257,[0,[0,"Tan (goat pattern)","en","Tan_(goat_pattern)"],[0,"Saanen goat","en","Saanen_goat"],[0,"Saanen (race caprine)","fr","Saanen_(race_caprine)"],[0,"Ch\xc3\xa8vre","fr","Ch%C3%A8vre"],[0,"P\xc3\xa9lardon","fr","P%C3%A9lardon"],[0,"Rocamadour (fromage)","fr","Rocamadour_(fromage)"]],[0,"http://upload.wikimedia.org/wikipedia/commons/f/f5/Saanenziege.jpg"]],[0,"rupicapra","Rupicapra_rupicapra_0.jpg","By Andreas Tille [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,640,[0,[0,"Rupicapra","en",""],[0,"Alps","en",""],[0,"Lac du Crachet","fr","Lac_du_Crachet"],[0,"Val Trupchun","fr","Val_Trupchun"],[0,"Chamois","fr",""],[0,"Alpes","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/f/f1/Rupicapra_rupicapra_0.jpg/800px-Rupicapra_rupicapra_0.jpg"]],[0,"mouton","Schaf_bei_Woodhenge1.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",800,600,[0,[0,"Ovis","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/1/1f/Schaf_bei_Woodhenge1.jpg/800px-Schaf_bei_Woodhenge1.jpg"]],[0,"mouflon","Mouflon_2.jpg","Jdennett77 [GFDL or CC-BY-SA-3.0 or CC-BY-2.5]",800,598,[0,[0,"Ovis","en",""],[0,"Mouflon","en",""],[0,"Ovina","fr",""],[0,"Ovis orientalis","fr","Ovis_orientalis"],[0,"Ovis","fr",""],[0,"Mouflon m\xc3\xa9diterran\xc3\xa9en","fr","Mouflon_m%C3%A9diterran%C3%A9en"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/7/74/Mouflon_2.jpg/800px-Mouflon_2.jpg"]],[0,"connochaetes","Wildebeest_Steve_Evans.jpg","By Steve Evans from Citizen of the World (South Africa) [CC-BY-2.0]",800,533,[0,[0,"Gnou","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/c/c8/Wildebeest_Steve_Evans.jpg/800px-Wildebeest_Steve_Evans.jpg"]],[0,"oryx","Oryx_samburu.jpg","By \\"Daniel Fafard (Dreamdan)\\" (Auteur) [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,545,[0,[0,"Oryx","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/1/1d/Oryx_samburu.jpg/800px-Oryx_samburu.jpg"]],[0,"aepyceros","Serengeti_Impala3.jpg","By Ikiwaner [GFDL 1.2]",800,800,[0,[0,"Impala","en",""],[0,"Parc national de l\'\xc3\xaele Ndere","fr","Parc_national_de_l%27%C3%AEle_Ndere"],[0,"Impala","fr",""],[0,"Gazelle","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/3/34/Serengeti_Impala3.jpg/800px-Serengeti_Impala3.jpg"]],[0,"bison","Bison_bison_009.jpg","By Donnie from WV, USA (VAC2010 1236\\nUploaded by berichard) [CC-BY-SA-2.0]",800,506,[0,[0,"Bison d\'Am\xc3\xa9rique du Nord","fr","Bison_d%27Am%C3%A9rique_du_Nord"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/d/d5/Bison_bison_009.jpg/800px-Bison_bison_009.jpg"]],[0,"bos","Kuh_in_transkei.jpg","By Amada44 [Public domain]",800,532,[0,[0,"Afrikaner cattle","en","Afrikaner_cattle"],[0,"\xc3\x89levage bovin en Afrique du Sud","fr","%C3%89levage_bovin_en_Afrique_du_Sud"],[0,"Sanga (rameau)","fr","Sanga_(rameau)"],[0,"Afrikaner (race bovine)","fr","Afrikaner_(race_bovine)"],[0,"Bos taurus","fr","Bos_taurus"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Kuh_in_transkei.jpg/800px-Kuh_in_transkei.jpg"]],[0,"syncerus","Syncerus_caffer.jpg","By PaulRae\\nderivative work: Berichard (talk)\\n\\n (African_Buffalo.JPG) [CC-BY-2.5 or CC-BY-SA-3.0 or GFDL]",800,697,[0,[0,"Buffle d\'Afrique","fr","Buffle_d%27Afrique"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/2/25/Syncerus_caffer.jpg/800px-Syncerus_caffer.jpg"]],[0,"cervus","Cervus_elaphus_Luc_Viatour_6.jpg","By Lviatour [CC-BY-SA-3.0]",800,533,[0,[0,"Cerf \xc3\xa9laphe","fr","Cerf_%C3%A9laphe"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/4/4b/Cervus_elaphus_Luc_Viatour_6.jpg/800px-Cervus_elaphus_Luc_Viatour_6.jpg"]],[0,"alces","Moose-Gustav.jpg","Author information on Wikimedia Commons [Attribution or GFDL or CC-BY-SA-3.0 or CC-BY-2.5]",600,450,[0,[0,"Red Marsh Nature Reserve","en","Red_Marsh_Nature_Reserve"],[0,"Wolves and moose on Isle Royale","en","Wolves_and_moose_on_Isle_Royale"],[0,"Alces alces","fr","Alces_alces"]],[0,"http://upload.wikimedia.org/wikipedia/commons/c/c9/Moose-Gustav.jpg"]],[0,"capreolus","Chevreuil_repos.jpg","By Asabengurtza [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,600,[0,[0,"Felix Salten","fr","Felix_Salten"],[0,"Chevreuil","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/3/33/Chevreuil_repos.jpg/800px-Chevreuil_repos.jpg"]],[0,"okapia","Okapi2.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",800,695,[0,[0,"Donodon","en",""],[0,"Dorsetodon","en",""],[0,"Drescheratherium","en",""],[0,"Henkelotherium","en",""],[0,"Brancatherulum","en",""],[0,"Tragulina","en",""],[0,"Harbor seal","en","Harbor_seal"],[0,"Manzano Mountain Cottontail","en","Manzano_Mountain_Cottontail"],[0,"Mixodectidae","en",""],[0,"Robust Cottontail","en","Robust_Cottontail"],[0,"Euthlastus","en",""],[0,"Comotherium","en",""],[0,"Dryolestes","en",""],[0,"Laolestes","en",""],[0,"Miccylotyrans","en",""],[0,"Parcs nationaux congolais (RDC)","fr","Parcs_nationaux_congolais_(RDC)"],[0,"1901 en science","fr","1901_en_science"],[0,"G\xc3\xa9ographie de la R\xc3\xa9publique d\xc3\xa9mocratique du Congo","fr","G%C3%A9ographie_de_la_R%C3%A9publique_d%C3%A9mocratique_du_Congo"],[0,"Okapi","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/1/18/Okapi2.jpg/800px-Okapi2.jpg"]],[0,"giraffa","Giraffa_camelopardalis_angolensis.jpg","
\xc2\xa9 Hans Hillewaert\xc2\xa0/\xc2\xa0CC-BY-SA-3.0
",800,1067,[0,[0,"Giraffe","en",""],[0,"Oshikoto","fr",""],[0,"Girafe","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/e0/Giraffa_camelopardalis_angolensis.jpg/800px-Giraffa_camelopardalis_angolensis.jpg"]],[0,"hippopotamus","Hippo_pod_edit.jpg","By Paul Maritz [GFDL or CC-BY-SA-3.0]",800,533,[0,[0,"Mammalia in the 10th edition of Systema Naturae","en","Mammalia_in_the_10th_edition_of_Systema_Naturae"],[0,"Largest organisms","en","Largest_organisms"],[0,"Wildlife of Zambia","en","Wildlife_of_Zambia"],[0,"Cetruminantia","en",""],[0,"Whippomorpha","en",""],[0,"Kasungu National Park","en","Kasungu_National_Park"],[0,"South Luangwa National Park","en","South_Luangwa_National_Park"],[0,"Democratic Republic of the Congo","en","Democratic_Republic_of_the_Congo"],[0,"Hippopotamidae","en",""],[0,"Hippopotamus","en",""],[0,"Mammif\xc3\xa8re aquatique","fr","Mammif%C3%A8re_aquatique"],[0,"Gabon","fr",""],[0,"Hippopotamus amphibius","fr","Hippopotamus_amphibius"],[0,"Hippopotamidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/a/a3/Hippo_pod_edit.jpg/800px-Hippo_pod_edit.jpg"]],[0,"orcinus","Killerwhales_jumping.jpg","By Pittman [Public domain]",450,313,[0,[0,"Mammals of Olympic National Park","en","Mammals_of_Olympic_National_Park"],[0,"Captive killer whales","en","Captive_killer_whales"],[0,"Life (BBC TV series)","en","Life_(BBC_TV_series)"],[0,"Flora and fauna of Greenland","en","Flora_and_fauna_of_Greenland"],[0,"Mammals of Antarctica","en","Mammals_of_Antarctica"],[0,"Bluespotted stingray","en","Bluespotted_stingray"],[0,"Cosmopolitan distribution","en","Cosmopolitan_distribution"],[0,"Megafauna","en",""],[0,"Killer whale","en","Killer_whale"],[0,"Dolphin","en",""],[0,"Orientation bibliographique en zoologie (taxinomie)","fr","Orientation_bibliographique_en_zoologie_(taxinomie)"],[0,"Superpr\xc3\xa9dateur","fr","Superpr%C3%A9dateur"],[0,"Parc national Olympique","fr","Parc_national_Olympique"],[0,"Orque","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/3/37/Killerwhales_jumping.jpg"]],[0,"phocoena","Daan_Close_Up.PNG","By AVampireTear [GFDL or CC-BY-SA-3.0]",675,583,[0,[0,"Harbour porpoise","en","Harbour_porpoise"],[0,"Marsouin commun","fr","Marsouin_commun"],[0,"Phocoenidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/2/28/Daan_Close_Up.PNG"]],[0,"monodon","Narwhals_breach.jpg","By Glenn Williams (National Institute of Standards and Technology) [Public domain]",800,509,[0,[0,"Ivory trade","en","Ivory_trade"],[0,"Tusk","en",""],[0,"Narwhal","en",""],[0,"Corne de licorne","fr","Corne_de_licorne"],[0,"D\xc3\xa9fense (dent)","fr","D%C3%A9fense_(dent)"],[0,"Narval","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/5/5c/Narwhals_breach.jpg/800px-Narwhals_breach.jpg"]],[0,"delphinapterus","Delphinapterus_leucas_head_3.jpg","Stan Shebs [GFDL or CC-BY-SA-3.0 or CC-BY-SA-2.5]",800,573,[0,[0,"B\xc3\xa9luga (baleine)","fr","B%C3%A9luga_(baleine)"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/7/7b/Delphinapterus_leucas_head_3.jpg/800px-Delphinapterus_leucas_head_3.jpg"]],[0,"balaenoptera","Humpback_stellwagen_edit.jpg","By Whit Welles Wwelles14 [GFDL or CC-BY-3.0]",800,453,[0,[0,"Silas D. Alben","en","Silas_D._Alben"],[0,"Stellwagen Bank National Marine Sanctuary","en","Stellwagen_Bank_National_Marine_Sanctuary"],[0,"National Recording Registry","en","National_Recording_Registry"],[0,"Cetartiodactyla","en",""],[0,"Cetology","en",""],[0,"Whale surfacing behaviour","en","Whale_surfacing_behaviour"],[0,"Whale watching","en","Whale_watching"],[0,"Humpback whale","en","Humpback_whale"],[0,"Baleen whale","en","Baleen_whale"],[0,"Whale","en",""],[0,"Cetacea","en",""],[0,"Baleine \xc3\xa0 bosse","fr","Baleine_%C3%A0_bosse"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/9/9e/Humpback_stellwagen_edit.jpg/800px-Humpback_stellwagen_edit.jpg"]],[0,"phacochoerus","Tarangire_Warzenschwein1.jpg","By Ikiwaner [GFDL 1.2]",800,600,[0,[0,"Warthog","en",""],[0,"Phacoch\xc3\xa8re","fr","Phacoch%C3%A8re"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/01/Tarangire_Warzenschwein1.jpg/800px-Tarangire_Warzenschwein1.jpg"]],[0,"sus","WildZwijn_cropped.jpg","By nl:User:GerardM (Image:WildZwijn.jpg) [GFDL or CC-BY-SA-3.0]",800,606,[0,[0,"Sanglier","fr",""],[0,"Fenouill\xc3\xa8des","fr","Fenouill%C3%A8des"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/6/61/WildZwijn_cropped.jpg/800px-WildZwijn_cropped.jpg"]],[0,"camel","07._Camel_Profile,_near_Silverton,_NSW,_07.07.2007.jpg","By Jjron [GFDL or CC-BY-SA-3.0]",800,985,[0,[0,"Mandora Marsh","en","Mandora_Marsh"],[0,"Australian feral camel","en","Australian_feral_camel"],[0,"Taboo food and drink","en","Taboo_food_and_drink"],[0,"Invasive species in Australia","en","Invasive_species_in_Australia"],[0,"Dromedary","en",""],[0,"Camelid","en",""],[0,"Tylopoda","en",""],[0,"Camel","en",""],[0,"Dromadaire australien","fr","Dromadaire_australien"],[0,"Dromadaire","fr",""],[0,"Camelidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/4/43/07._Camel_Profile%2C_near_Silverton%2C_NSW%2C_07.07.2007.jpg/800px-07._Camel_Profile%2C_near_Silverton%2C_NSW%2C_07.07.2007.jpg"]],[0,"lama","Lama_animal.jpg","Author information on Wikimedia Commons [CC-BY-SA-2.5]",800,600,[0,[0,"Lama (animal)","fr","Lama_(animal)"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/6/6a/Lama_animal.jpg/800px-Lama_animal.jpg"]],[0,"lutra","Loutre_des_pyrenees_baronnies_2004.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",594,394,[0,[0,"Lac Arpi","fr","Lac_Arpi"],[0,"Petite Amazonie des Pyr\xc3\xa9n\xc3\xa9es","fr","Petite_Amazonie_des_Pyr%C3%A9n%C3%A9es"],[0,"G\xc3\xa9ographie de la Charente","fr","G%C3%A9ographie_de_la_Charente"],[0,"Vis (rivi\xc3\xa8re)","fr","Vis_(rivi%C3%A8re)"],[0,"Lutra","fr",""],[0,"Loutre d\'Europe","fr","Loutre_d%27Europe"],[0,"Loutre","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/c/c3/Loutre_des_pyrenees_baronnies_2004.jpg"]],[0,"procyon","Procyon_lotor_1.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",800,927,[0,[0,"Procyonidae","fr",""],[0,"Am\xc3\xa9rique du Nord","fr","Am%C3%A9rique_du_Nord"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/c/c3/Procyon_lotor_1.jpg/800px-Procyon_lotor_1.jpg"]],[0,"simocyon","Red_Panda.JPG","By User Bernard Landgraf on de.wikipedia.org [GFDL or CC-BY-SA-3.0]",800,534,[0,[0,"Wildlife of India","en","Wildlife_of_India"],[0,"Red panda","en","Red_panda"],[0,"Ailuridae","fr",""],[0,"Petit panda","fr","Petit_panda"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/c/c6/Red_Panda.JPG/800px-Red_Panda.JPG"]],[0,"mephitis","Striped_skunk.jpg","Author information on Wikimedia Commons [Public domain]",300,437,[0,[0,"Mammals of the Indiana Dunes","en","Mammals_of_the_Indiana_Dunes"],[0,"Mammals of New England","en","Mammals_of_New_England"],[0,"P\xc3\xa9p\xc3\xa9 le putois","fr","P%C3%A9p%C3%A9_le_putois"],[0,"Mouffette","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/6/63/Striped_skunk.jpg"]],[0,"mirounga","Mirounga_leonina_male.JPG","By B.navez (self-made (scan of paper photo)) [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,544,[0,[0,"Southern elephant seal","en","Southern_elephant_seal"],[0,"Largest organisms","en","Largest_organisms"],[0,"Elephant seal","en","Elephant_seal"],[0,"Carnivora","en",""],[0,"\xc3\x89l\xc3\xa9phant de mer du sud","fr","%C3%89l%C3%A9phant_de_mer_du_sud"],[0,"Province de Santa Cruz","fr","Province_de_Santa_Cruz"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ed/Mirounga_leonina_male.JPG/800px-Mirounga_leonina_male.JPG"]],[0,"arctocephalus","Arctocephalus_galapagoensis2.jpg","By Kelly J. Kane [GFDL or CC-BY-3.0]",800,800,[0,[0,"Gal\xc3\xa1pagos Sea Lion","en","Gal%C3%A1pagos_Sea_Lion"],[0,"Arctocephalus galapagoensis","fr","Arctocephalus_galapagoensis"],[0,"Nageoire","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/f/f9/Arctocephalus_galapagoensis2.jpg/800px-Arctocephalus_galapagoensis2.jpg"]],[0,"odobenus","Noaa-walrus30.jpg","Author information on Wikimedia Commons [Public domain]",700,455,[0,[0,"Odobenus","fr",""],[0,"Odobenidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/d/de/Noaa-walrus30.jpg"]],[0,"ursus","Polar_Bear_2004-11-15.jpg","By Ansgar Walk [CC-BY-SA-2.5]",800,606,[0,[0,"Nordic countries","en","Nordic_countries"],[0,"Polar seas","en","Polar_seas"],[0,"Wapusk National Park","en","Wapusk_National_Park"],[0,"Polar region","en","Polar_region"],[0,"Megafauna","en",""],[0,"Bear","en",""],[0,"Parcs nationaux du Canada","fr","Parcs_nationaux_du_Canada"],[0,"Embl\xc3\xa8mes des provinces et territoires du Canada","fr","Embl%C3%A8mes_des_provinces_et_territoires_du_Canada"],[0,"Parc national Wapusk","fr","Parc_national_Wapusk"],[0,"Ours blanc","fr","Ours_blanc"],[0,"Oc\xc3\xa9an Arctique","fr","Oc%C3%A9an_Arctique"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ec/Polar_Bear_2004-11-15.jpg/800px-Polar_Bear_2004-11-15.jpg"]],[0,"tremarctos","Spectacled_Bear_-_Houston_Zoo.jpg","By en:User:Cburnett [GFDL or CC-BY-SA-3.0]",800,728,[0,[0,"Ichigkat muja \xe2\x80\x93 Cordillera del Condor National Park","en","Ichigkat_muja_%E2%80%93_Cordillera_del_Condor_National_Park"],[0,"Serran\xc3\xada de los Churumbelos","en","Serran%C3%ADa_de_los_Churumbelos"],[0,"Tremarctos","en",""],[0,"Spectacled bear","en","Spectacled_bear"],[0,"Ours \xc3\xa0 lunettes","fr","Ours_%C3%A0_lunettes"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/9/99/Spectacled_Bear_-_Houston_Zoo.jpg/800px-Spectacled_Bear_-_Houston_Zoo.jpg"]],[0,"ailuropoda","Grosser_Panda.JPG","By J. Patrick Fischer [CC-BY-SA-3.0]",800,533,[0,[0,"World Wide Fund for Nature","en","World_Wide_Fund_for_Nature"],[0,"Giant panda","en","Giant_panda"],[0,"Panda g\xc3\xa9ant","fr","Panda_g%C3%A9ant"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/0f/Grosser_Panda.JPG/800px-Grosser_Panda.JPG"]],[0,"canis","Wolf._bei_Eekholt.jpg","By Volker.G [GFDL or CC-BY-3.0]",800,600,[0,[0,"B\xc3\xaate du G\xc3\xa9vaudan","fr","B%C3%AAte_du_G%C3%A9vaudan"],[0,"Loup","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ee/Wolf._bei_Eekholt.jpg/800px-Wolf._bei_Eekholt.jpg"]],[0,"vulpes","R%C3%B8d_r%C3%A6v_%28Vulpes_vulpes%29.jpg","I, Malene [GFDL or CC-BY-SA-3.0 or CC-BY-2.5]",800,560,[0,[0,"Burns Inquiry","en","Burns_Inquiry"],[0,"Fox hunting","en","Fox_hunting"],[0,"Renard roux","fr","Renard_roux"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ef/R%C3%B8d_r%C3%A6v_%28Vulpes_vulpes%29.jpg/800px-R%C3%B8d_r%C3%A6v_%28Vulpes_vulpes%29.jpg"]],[0,"suricata","Suricata_suricatta18082009b.jpg","By Sylfred1977 [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,1198,[0,[0,"Suricate","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/d/dd/Suricata_suricatta18082009b.jpg/800px-Suricata_suricatta18082009b.jpg"]],[0,"parahyaena","Parahyaena_brunnea_3.jpg","By http://www.pistoleros.no (http://www.pistoleros.no) [GFDL or CC-BY-SA-3.0]",300,221,[0,[0,"Hy\xc3\xa8ne brune","fr","Hy%C3%A8ne_brune"],[0,"Parahyaena","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/0/04/Parahyaena_brunnea_3.jpg"]],[0,"neofelis","Neofelis_nebulosa.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",432,252,[0,[0,"Kameng Elephant Reserve","en","Kameng_Elephant_Reserve"],[0,"Neofelis","en",""],[0,"Clouded leopard","en","Clouded_leopard"],[0,"Neofelis","fr",""],[0,"Panth\xc3\xa8re n\xc3\xa9buleuse","fr","Panth%C3%A8re_n%C3%A9buleuse"],[0,"Pardofelis","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/7/7d/Neofelis_nebulosa.jpg"]],[0,"panthera","Lion_waiting_in_Namibia.jpg","By yaaaay (Originally posted on Flickr at The King.) [CC-BY-2.0]",800,600,[0,[0,"Lion (color)","en","Lion_(color)"],[0,"Lion","en",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/7/73/Lion_waiting_in_Namibia.jpg/800px-Lion_waiting_in_Namibia.jpg"]],[0,"felis","WhiteCat.jpg","By Icebooter at en.wikipedia Later versions were uploaded by JamesWeb, Pd THOR, Bean2020, Balls187, Persian Poet Gal at en.wikipedia. [GFDL or CC-BY-SA-3.0 or GFDL]",348,326,[0,[0,"Feline hip replacement","en","Feline_hip_replacement"],[0,"Kass","en",""],[0,"Cat","en",""],[0,"Carnivora","en",""],[0,"Chat","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/b/b2/WhiteCat.jpg"]],[0,"lynx","Linces10.jpg","By (c)\\"Programa de Conservaci\xc3\xb3n Ex-situ del Lince Ib\xc3\xa9rico www.lynxexsitu.es\\" [CC-BY-2.5]",294,420,[0,[0,"Genetic monitoring","en","Genetic_monitoring"],[0,"Lynx","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/f/f5/Linces10.jpg"]],[0,"acinonyx","TheCheethcat.jpg","By James Temple [CC-BY-2.0]",800,1200,[0,[0,"Cheetah","en",""],[0,"Mammal","en",""],[0,"Gu\xc3\xa9pard","fr","Gu%C3%A9pard"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/09/TheCheethcat.jpg/800px-TheCheethcat.jpg"]],[0,"ceratotherium","Rhinoc%C3%A9ros_blanc_JHE.jpg","By Coralie [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,434,[0,[0,"Rhinoc\xc3\xa9ros","fr","Rhinoc%C3%A9ros"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/3/38/Rhinoc%C3%A9ros_blanc_JHE.jpg/800px-Rhinoc%C3%A9ros_blanc_JHE.jpg"]],[0,"equus_grevyi","Zebra_zoo-leipzig.jpg","By Thomas Lersch [CC-BY-SA-2.5]",800,600,[0,[0,"Equus (genus)","en","Equus_(genus)"],[0,"Z\xc3\xa8bre de Gr\xc3\xa9vy","fr","Z%C3%A8bre_de_Gr%C3%A9vy"],[0,"Equidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/0a/Zebra_zoo-leipzig.jpg/800px-Zebra_zoo-leipzig.jpg"]],[0,"equus_asinus","Equus_asinus_Kadzid%C5%82owo_002.jpg","By Lilly M [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,516,[0,[0,"Asses\' milk (Donkey\'s milk)","en","Asses%27_milk_(Donkey%27s_milk)"],[0,"Lait d\'\xc3\xa2nesse","fr","Lait_d%27%C3%A2nesse"],[0,"Equidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/b/b7/Equus_asinus_Kadzid%C5%82owo_002.jpg/800px-Equus_asinus_Kadzid%C5%82owo_002.jpg"]],[0,"equus_caballus","Pferde_im_Galopp.jpg","Author information on Wikimedia Commons [CC-BY-SA-2.5]",800,371,[0,[0,"Equine coat color","en","Equine_coat_color"],[0,"Cheval","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/e9/Pferde_im_Galopp.jpg/800px-Pferde_im_Galopp.jpg"]],[0,"plecotus","Plecotus_auritus_01.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0 or CC-BY-SA-2.0]",800,600,[0,[0,"Mother Ludlam\'s Cave","en","Mother_Ludlam%27s_Cave"],[0,"Norfolk Roadside Nature Reserve","en","Norfolk_Roadside_Nature_Reserve"],[0,"Plecotus","en",""],[0,"Brown long-eared bat","en","Brown_long-eared_bat"],[0,"Chiroptera (classification phylog\xc3\xa9n\xc3\xa9tique)","fr","Chiroptera_(classification_phylog%C3%A9n%C3%A9tique)"],[0,"Plecotus auritus","fr","Plecotus_auritus"],[0,"For\xc3\xaat de Soignes","fr","For%C3%AAt_de_Soignes"],[0,"Oreillard","fr",""],[0,"Vespertilionidae","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/8/8b/Plecotus_auritus_01.jpg/800px-Plecotus_auritus_01.jpg"]],[0,"rhinolophus","Grand_Rhinolophe.jpg","By Marie Jullion [GFDL or CC-BY-SA-3.0-2.5-2.0-1.0]",800,600,[0,[0,"Greater Horseshoe Bat","en","Greater_Horseshoe_Bat"],[0,"Plateau d\'Albion","fr","Plateau_d%27Albion"],[0,"Alpes dinariques","fr","Alpes_dinariques"],[0,"Rhinolophus ferrumequinum","fr","Rhinolophus_ferrumequinum"],[0,"Biosp\xc3\xa9ologie","fr","Biosp%C3%A9ologie"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/0a/Grand_Rhinolophe.jpg/800px-Grand_Rhinolophe.jpg"]],[0,"talpa","Talpa_europaea_hg.jpg","By Hannes Grobe, Hgrobe 21:20, 4 July 2006 (UTC) [CC-BY-SA-2.5]",800,571,[0,[0,"European Mole","en","European_Mole"],[0,"Taupe d\'Europe","fr","Taupe_d%27Europe"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/9/9e/Talpa_europaea_hg.jpg/800px-Talpa_europaea_hg.jpg"]],[0,"erinaceus","Erinaceus_europaeus_LC0119.jpg","I, J\xc3\xb6rg Hempel [CC-BY-SA-2.0-de]",800,599,[0,[0,"Erinaceus europaeus","fr","Erinaceus_europaeus"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/e1/Erinaceus_europaeus_LC0119.jpg/800px-Erinaceus_europaeus_LC0119.jpg"]],[0,"sorex","Common_Shrew.jpg","By Sjonge at en.wikipedia [Public domain]",800,600,[0,[0,"Common Shrew","en","Common_Shrew"],[0,"Raasay","fr",""],[0,"Musaraigne","fr",""],[0,"Sorex araneus","fr","Sorex_araneus"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/0/0d/Common_Shrew.jpg/800px-Common_Shrew.jpg"]],[0,"homo","Infant_smile.jpg","By Mehregan Javanmard [GFDL or CC-BY-SA-3.0 or CC-BY-2.5]",800,1237,[0,[0,"Homo sapiens","fr","Homo_sapiens"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/1/1f/Infant_smile.jpg/800px-Infant_smile.jpg"]],[0,"pan","Schimpanse_zoo-leipig.jpg","By Thomas Lersch [GFDL or CC-BY-SA-3.0 or CC-BY-2.5]",800,600,[0,[0,"Chimpanzee","en",""],[0,"Common chimpanzee","en","Common_chimpanzee"],[0,"Gabon","fr",""],[0,"Chimpanz\xc3\xa9","fr","Chimpanz%C3%A9"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/8/8b/Schimpanse_zoo-leipig.jpg/800px-Schimpanse_zoo-leipig.jpg"]],[0,"gorilla","Gorilla_gorilla_gorilla8.jpg","Author information on Wikimedia Commons [GFDL or CC-BY-SA-3.0]",800,1067,[0,[0,"Gabon","fr",""],[0,"Gorille","fr",""]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/6/6e/Gorilla_gorilla_gorilla8.jpg/800px-Gorilla_gorilla_gorilla8.jpg"]],[0,"pongo","Kutai_Orangutan_2008.jpg","By Neil WWW.NEILSRTW.BLOGSPOT.COM (Wild Orangutan) [CC-BY-2.0]",800,977,[0,[0,"Kutai National Park","en","Kutai_National_Park"],[0,"Orang-outan de Born\xc3\xa9o","fr","Orang-outan_de_Born%C3%A9o"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/e/ee/Kutai_Orangutan_2008.jpg/800px-Kutai_Orangutan_2008.jpg"]],[0,"macaca","JapaneseMacaque1_CincinnatiZoo.jpg","By Ltshears [CC-BY-SA-3.0 or GFDL]",800,650,[0,[0,"Macaque japonais","fr","Macaque_japonais"]],[0,"http://upload.wikimedia.org/wikipedia/commons/thumb/9/9e/JapaneseMacaque1_CincinnatiZoo.jpg/800px-JapaneseMacaque1_CincinnatiZoo.jpg"]],[0,"callitrix","Wei%C3%9Fb%C3%BCschelaffe_%28Callithrix_jacchus%29.jpg","