├── .exclude ├── .gitignore ├── LICENSE ├── Makefile ├── README.markdown ├── TODO ├── bin └── ocamlfindjs ├── build └── mkruntimedef.sh ├── configure ├── examples ├── Makefile ├── README ├── dom │ ├── Makefile │ ├── canvas │ │ ├── Makefile │ │ ├── _tags │ │ ├── canvas.ml │ │ └── index.html │ ├── minesweeper │ │ ├── LICENSE │ │ ├── Makefile │ │ ├── README │ │ ├── _tags │ │ ├── index.html │ │ ├── main.ml │ │ ├── minesweeper.ml │ │ └── sprites │ │ │ ├── 1.png │ │ │ ├── 2.png │ │ │ ├── 3.png │ │ │ ├── 4.png │ │ │ ├── 5.png │ │ │ ├── 6.png │ │ │ ├── 7.png │ │ │ ├── 8.png │ │ │ ├── bomb.png │ │ │ ├── empty.png │ │ │ ├── flag.png │ │ │ ├── normal.png │ │ │ └── scalable.svg │ ├── planet │ │ ├── Makefile │ │ ├── _tags │ │ ├── index.html │ │ ├── planet.ml │ │ └── texture.jpg │ └── sudoku │ │ ├── Makefile │ │ ├── _tags │ │ ├── index.html │ │ └── sudoku.ml ├── index.html ├── jquery │ ├── Makefile │ └── live_examples │ │ ├── Makefile │ │ ├── _tags │ │ ├── index.html │ │ └── live_examples.ml └── jslib │ ├── ppp │ ├── Makefile │ ├── _tags │ ├── myocamlbuild.ml │ ├── ppp.ml │ └── test.js │ └── quot │ ├── Makefile │ ├── _tags │ ├── myocamlbuild.ml │ └── quot.ml ├── src ├── dom │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── dom.ml │ ├── dom.mli │ └── dom.mllib ├── gmaps │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── gmaps.ml │ ├── gmaps.mli │ └── gmaps.mllib ├── javascript │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── javascript.ml │ └── javascript.mli ├── jquery │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── jQuery.ml │ ├── jQuery.mli │ ├── jquery.mllib │ └── pa_jquery.ml ├── jscomp │ ├── Makefile │ ├── _tags │ ├── emitjs.ml │ ├── emitjs.mli │ ├── jscompile.ml │ ├── jscompile.mli │ ├── jserrors.ml │ ├── jserrors.mli │ ├── jsgen.ml │ ├── jsgen.mli │ ├── jslibrarian.ml │ ├── jslibrarian.mli │ ├── jslink.ml │ ├── jslink.mli │ ├── jsmain.ml │ ├── jsmain.mli │ ├── jsmain_args.ml │ ├── jsmain_args.mli │ ├── jspackager.ml │ ├── jspackager.mli │ ├── myocamlbuild.mlp │ ├── ocamljs_config.ml │ └── patches │ │ ├── 3.11.0 │ │ ├── Makefile │ │ ├── translclass.ml │ │ ├── translclass.ml.orig │ │ ├── translclass.ml.patch │ │ ├── translcore.ml │ │ ├── translcore.ml.orig │ │ ├── translcore.ml.patch │ │ ├── translobj.ml │ │ ├── translobj.ml.orig │ │ ├── translobj.ml.patch │ │ ├── typecore.ml │ │ ├── typecore.ml.orig │ │ └── typecore.ml.patch │ │ ├── 3.11.1 │ │ ├── Makefile │ │ ├── translclass.ml │ │ ├── translclass.ml.orig │ │ ├── translclass.ml.patch │ │ ├── translcore.ml │ │ ├── translcore.ml.orig │ │ ├── translcore.ml.patch │ │ ├── translobj.ml │ │ ├── translobj.ml.orig │ │ ├── translobj.ml.patch │ │ ├── typecore.ml │ │ ├── typecore.ml.orig │ │ └── typecore.ml.patch │ │ ├── 3.11.2 │ │ ├── Makefile │ │ ├── translclass.ml │ │ ├── translclass.ml.orig │ │ ├── translclass.ml.patch │ │ ├── translcore.ml │ │ ├── translcore.ml.orig │ │ ├── translcore.ml.patch │ │ ├── translobj.ml │ │ ├── translobj.ml.orig │ │ ├── translobj.ml.patch │ │ ├── typecore.ml │ │ ├── typecore.ml.orig │ │ └── typecore.ml.patch │ │ └── 3.12.0 │ │ ├── Makefile │ │ ├── translclass.ml │ │ ├── translclass.ml.orig │ │ ├── translclass.ml.patch │ │ ├── translcore.ml │ │ ├── translcore.ml.orig │ │ ├── translcore.ml.patch │ │ ├── translobj.ml │ │ ├── translobj.ml.orig │ │ ├── translobj.ml.patch │ │ ├── typecore.ml │ │ ├── typecore.ml.orig │ │ └── typecore.ml.patch ├── jslib │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── jslib.mllib │ ├── jslib_ast.incl │ ├── jslib_ast.ml │ ├── jslib_ast.mli │ ├── jslib_lexer.ml │ ├── jslib_lexer.mli │ ├── jslib_parse.ml │ ├── jslib_parse.mli │ ├── jslib_pp.ml │ ├── jslib_pp.mli │ ├── lambda_meta_generator.ml │ ├── syntax_inline.ml │ ├── syntax_lambda.ml │ └── syntax_quotations.ml ├── lwt-dom │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── lwt_dom.ml │ └── lwt_dom.mli ├── lwt │ ├── META.patch │ ├── Makefile │ └── _tags ├── mozilla │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── mozilla.ml │ └── mozilla.mli ├── ocamljs │ ├── META │ ├── Makefile │ ├── _tags │ ├── doc.odocl │ ├── ocamljs.ml │ └── ocamljs.mli ├── ounit │ ├── META.patch │ ├── Makefile │ ├── README │ ├── _tags │ ├── js.patch │ ├── oUnit.ml.patch │ └── ounit.mllib └── stdlib │ ├── Makefile │ ├── _tags │ ├── myocamlbuild.mlp │ ├── patches │ ├── 3.11.0 │ │ ├── Makefile │ │ ├── buffer.ml │ │ ├── buffer.ml.orig │ │ ├── buffer.ml.patch │ │ ├── camlinternalMod.ml │ │ ├── camlinternalMod.ml.orig │ │ ├── camlinternalMod.ml.patch │ │ ├── camlinternalOO.ml │ │ ├── camlinternalOO.ml.orig │ │ ├── camlinternalOO.ml.patch │ │ ├── pervasives.ml │ │ ├── pervasives.ml.orig │ │ ├── pervasives.ml.patch │ │ ├── printf.ml │ │ ├── printf.ml.orig │ │ └── printf.ml.patch │ ├── 3.11.1 │ │ ├── Makefile │ │ ├── buffer.ml │ │ ├── buffer.ml.orig │ │ ├── buffer.ml.patch │ │ ├── camlinternalMod.ml │ │ ├── camlinternalMod.ml.orig │ │ ├── camlinternalMod.ml.patch │ │ ├── camlinternalOO.ml │ │ ├── camlinternalOO.ml.orig │ │ ├── camlinternalOO.ml.patch │ │ ├── pervasives.ml │ │ ├── pervasives.ml.orig │ │ ├── pervasives.ml.patch │ │ ├── printf.ml │ │ ├── printf.ml.orig │ │ └── printf.ml.patch │ ├── 3.11.2 │ │ ├── Makefile │ │ ├── buffer.ml │ │ ├── buffer.ml.orig │ │ ├── buffer.ml.patch │ │ ├── camlinternalMod.ml │ │ ├── camlinternalMod.ml.orig │ │ ├── camlinternalMod.ml.patch │ │ ├── camlinternalOO.ml │ │ ├── camlinternalOO.ml.orig │ │ ├── camlinternalOO.ml.patch │ │ ├── pervasives.ml │ │ ├── pervasives.ml.orig │ │ ├── pervasives.ml.patch │ │ ├── printf.ml │ │ ├── printf.ml.orig │ │ └── printf.ml.patch │ └── 3.12.0 │ │ ├── Makefile │ │ ├── buffer.ml │ │ ├── buffer.ml.orig │ │ ├── buffer.ml.patch │ │ ├── camlinternalMod.ml │ │ ├── camlinternalMod.ml.orig │ │ ├── camlinternalMod.ml.patch │ │ ├── camlinternalOO.ml │ │ ├── camlinternalOO.ml.orig │ │ ├── camlinternalOO.ml.patch │ │ ├── pervasives.ml │ │ ├── pervasives.ml.orig │ │ ├── pervasives.ml.patch │ │ ├── printf.ml │ │ ├── printf.ml.orig │ │ └── printf.ml.patch │ ├── primitives.js │ ├── random.ml │ └── support.js ├── test ├── Makefile ├── jscomp │ ├── Makefile │ └── hello.ml ├── jslib │ ├── Makefile │ ├── _tags │ ├── main.ml │ └── parse.ml ├── ocamljs │ ├── Makefile │ ├── _tags │ ├── booleans.ml │ ├── main.ml │ ├── oo_class.ml │ ├── oo_class_arg.ml │ ├── oo_class_let.ml │ ├── oo_cloning.ml │ ├── oo_funobj.ml │ ├── oo_immediate.ml │ ├── oo_inherit.ml │ ├── oo_init.ml │ ├── oo_method_function_bug.ml │ ├── oo_private.ml │ ├── oo_self.ml │ ├── oo_super.ml │ ├── oo_this_bug.ml │ ├── oo_virtual.ml │ ├── raiseargs.ml │ └── tail_calls.ml └── stdlib │ ├── Makefile │ ├── _tags │ ├── main.ml │ ├── stdlib_array.ml │ ├── stdlib_hashtbl.ml │ ├── stdlib_lexing.mll │ ├── stdlib_parsing.mly │ ├── stdlib_parsing_stuff.ml │ ├── stdlib_parsing_tests.ml │ ├── stdlib_pervasives.ml │ └── stdlib_printf.ml └── tools └── myocamlbuild.ml /.exclude: -------------------------------------------------------------------------------- 1 | ocamljs-0.3/.exclude 2 | ocamljs-0.3/.git 3 | ocamljs-0.3/.gitignore 4 | ocamljs-0.3/*/patches/*/*.ml 5 | ocamljs-0.3/*/patches/*/*.ml.orig 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile.conf 2 | _build 3 | myocamlbuild.ml 4 | !tools/myocamlbuild.ml 5 | stage 6 | doc 7 | ocaml 8 | *.byte 9 | *.js 10 | *~ 11 | .#* 12 | src/lwt/*.ml* 13 | src/lwt/META* 14 | src/ounit/*.ml* 15 | src/ounit/META* 16 | src/stdlib/*.ml* 17 | !src/stdlib/random.ml 18 | !src/stdlib/primitives.js 19 | !src/stdlib/support.js 20 | src/jscomp/translclass.ml* 21 | src/jscomp/translcore.ml* 22 | src/jscomp/translobj.ml* 23 | src/jscomp/typecore.ml* 24 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | -include Makefile.conf 2 | 3 | all: 4 | mkdir -p stage 5 | for pkg in $(PKGLIST); do \ 6 | $(MAKE) -C src/$$pkg all || exit; \ 7 | done 8 | 9 | doc: 10 | mkdir -p doc 11 | for pkg in $(PKGLIST); do \ 12 | $(MAKE) -C src/$$pkg doc || exit; \ 13 | done 14 | find . -name '*.odoc' | awk '{print "-load"; print $$1}' | xargs ocamldoc -html -sort -d doc 15 | 16 | install: 17 | for pkg in $(PKGLIST); do \ 18 | $(MAKE) -C src/$$pkg install || exit; \ 19 | done 20 | install bin/ocamlfindjs $(BINDIR) 21 | 22 | uninstall: 23 | for pkg in $(PKGLIST); do \ 24 | $(MAKE) -C src/$$pkg uninstall || exit; \ 25 | done 26 | rm -f $(BINDIR)/ocamlfindjs 27 | 28 | clean: 29 | for pkg in $(PKGLIST); do \ 30 | $(MAKE) -C src/$$pkg clean || exit; \ 31 | done 32 | $(MAKE) -C test clean 33 | $(MAKE) -C examples clean 34 | rm -rf doc 35 | rm -rf stage 36 | 37 | distclean: clean 38 | rm -rf Makefile.conf 39 | rm -f ocaml 40 | 41 | test: 42 | $(MAKE) -C test 43 | 44 | examples: 45 | $(MAKE) -C examples 46 | 47 | .PHONY: test examples doc 48 | 49 | github: 50 | rsync -a --delete --exclude './' doc/ ../ocamljs.gh-pages/doc/ 51 | rsync -a -L --delete --delete-excluded --exclude _build/ --include '*/' --exclude myocamlbuild.ml --include '*.ml' --include '*.js' --include '*.html' --include '*.css' --include '*.png' --include '*.jpg' --exclude '*' examples/ ../ocamljs.gh-pages/examples/ 52 | 53 | dist: 54 | $(MAKE) distclean 55 | cd ..; \ 56 | mv ocamljs ocamljs-0.3; \ 57 | tar cvfz ocamljs-0.3.tar.gz --exclude-from ocamljs-0.3/.exclude ocamljs-0.3; \ 58 | mv ocamljs-0.3 ocamljs 59 | 60 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | #Ocamljs# 2 | 3 | `Ocamljs` is a system for compiling OCaml to Javascript. It includes a 4 | Javascript back-end for the OCaml compiler, as well as several support 5 | libraries, such as bindings to the browser DOM. `Ocamljs` also works 6 | with [orpc](http://jaked.github.com/orpc) for RPC over HTTP, and 7 | [froc](http://jaked.github.com/froc) for functional reactive browser 8 | programming. The full OCaml language and much of the OCaml standard 9 | library is supported. There is special support for the object system 10 | so Javascript objects may be called from OCaml and vice-versa. 11 | 12 | You can download `ocamljs` at [http://github.com/jaked/ocamljs/downloads](http://github.com/jaked/ocamljs/downloads). 13 | 14 | See [Introduction](Introduction.html) and [Installation](Installation.html). 15 | 16 | For a quick start: 17 | 18 | 0. Unpack OCaml source adjacent to the `ocamljs` tree 19 | 1. `./configure` 20 | 2. `make` 21 | 3. `make install` 22 | 4. `make examples` 23 | 24 | `Ocamljs` is written by Jake Donham, with contributions from 25 | 26 | * Dave Benjamin (jQuery binding and examples) 27 | * Haoyang Wang 28 | * Mike Wells 29 | * Stepan Zastupov 30 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | * dom 2 | - fill in more of API (HTML5 stuff) 3 | - more examples 4 | 5 | * lwt 6 | - examples 7 | 8 | * jslib 9 | - fill in more of parser 10 | - bug with locations 11 | - check pattern quotations 12 | - redo pretty-printing 13 | - examples 14 | 15 | * javascript 16 | - go through JS spec and wrap all the standard objects 17 | 18 | * jscomp 19 | - cleanup 20 | - cleaner heap rep (arrays, tag in last elem) 21 | - can we do better interoperating with exceptions? would be nice to be 22 | able to declare, catch, and match exceptions from JS libs. 23 | - better checking in inline Javascript? easy to refer to unbound 24 | vars. but sometimes useful or necessary. 25 | - can we avoid wrapping a function around for-loops when there are no 26 | closures in the body? any other places to avoid extra wrapping? 27 | 28 | * stdlib 29 | - implement String.concat natively 30 | - other things to implement natively? 31 | - steal heavily from js_of_ocaml 32 | 33 | * all 34 | - docs, wiki 35 | 36 | * bad ideas: 37 | - can we identify options to generate js val or null instead of 38 | boxing? need to be careful about "if (val)" tests, where val could 39 | be unboxed Javascript false value (0, "", etc.); must special case 40 | tests to "if (val != null)". turns out no. we can do the above (see 41 | null-options branch) but it breaks for nested options, since we 42 | can't distinguish e.g. None and Some None. a scheme to use 43 | different reps for different types must work with polymorphic 44 | functions. 45 | -------------------------------------------------------------------------------- /bin/ocamlfindjs: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | OCAMLJS=`echo $OCAMLFIND_COMMANDS | sed 's/ocamljs=\([^ ]*\)/\1/'` 4 | 5 | if [ $1 = ocamljs ]; then 6 | shift 7 | OCAMLFIND_COMMANDS=ocamlc=${OCAMLJS:-ocamljs} ocamlfind ocamlc -predicates js "$@" 8 | else 9 | ocamlfind $cmd "$@" 10 | fi 11 | -------------------------------------------------------------------------------- /build/mkruntimedef.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # $Id: mkruntimedef.sh,v 1.1.2.2 2007/03/12 11:58:48 pouillar Exp $ 3 | # copied from ocaml/build to fix paths (maybe there is a way to get 4 | # ocamlbuild to run the stock one in a different dir) 5 | echo 'let builtin_exceptions = [|'; \ 6 | sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p' ocaml/byterun/fail.h | \ 7 | sed -e '$s/;$//'; \ 8 | echo '|]'; \ 9 | echo 'let builtin_primitives = [|'; \ 10 | sed -e 's/.*/ "&";/' -e '$s/;$//' ocaml/byterun/primitives; \ 11 | echo '|]' 12 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | DIRS=dom jquery 2 | 3 | all: 4 | for dir in $(DIRS); do \ 5 | $(MAKE) -C $$dir all || exit; \ 6 | done 7 | 8 | clean: 9 | for dir in $(DIRS); do \ 10 | $(MAKE) -C $$dir clean || exit; \ 11 | done 12 | -------------------------------------------------------------------------------- /examples/README: -------------------------------------------------------------------------------- 1 | You need to build and install ocamljs and its libraries before 2 | building these examples. 3 | -------------------------------------------------------------------------------- /examples/dom/Makefile: -------------------------------------------------------------------------------- 1 | DIRS=canvas minesweeper sudoku planet 2 | 3 | all: 4 | for dir in $(DIRS); do \ 5 | $(MAKE) -C $$dir all || exit; \ 6 | done 7 | 8 | clean: 9 | for dir in $(DIRS); do \ 10 | $(MAKE) -C $$dir clean || exit; \ 11 | done 12 | -------------------------------------------------------------------------------- /examples/dom/canvas/Makefile: -------------------------------------------------------------------------------- 1 | JS=canvas.js 2 | 3 | all: myocamlbuild.ml 4 | ocamlbuild $(JS); ln -s _build/$(JS) . 5 | 6 | clean: 7 | ocamlbuild -clean 8 | rm -f myocamlbuild.ml 9 | 10 | myocamlbuild.ml: 11 | ln -s ../../../tools/myocamlbuild.ml 12 | -------------------------------------------------------------------------------- /examples/dom/canvas/_tags: -------------------------------------------------------------------------------- 1 | : pkg_dom 2 | : pkg_dom 3 | -------------------------------------------------------------------------------- /examples/dom/canvas/canvas.ml: -------------------------------------------------------------------------------- 1 | module D = Dom 2 | 3 | let onload () = 4 | let canvas = (D.document#getElementById "canvas" : D.canvas) in 5 | let ctx = canvas#getContext "2d" in 6 | 7 | ctx#_set_fillStyle "rgb(200,0,0)"; 8 | ctx#fillRect 10. 10. 55. 50.; 9 | 10 | ctx#_set_fillStyle "rgba(0,0,200,0.5)"; 11 | ctx#fillRect 30. 30. 55. 50.; 12 | 13 | ctx#beginPath; 14 | ctx#moveTo 75. 25.; 15 | ctx#quadraticCurveTo 25. 25. 25. 62.5; 16 | ctx#quadraticCurveTo 25. 100. 50. 100.; 17 | ctx#quadraticCurveTo 50. 120. 30. 125.; 18 | ctx#quadraticCurveTo 60. 120. 65. 100.; 19 | ctx#quadraticCurveTo 125. 100. 125. 62.5; 20 | ctx#quadraticCurveTo 125. 25. 75. 25.; 21 | ctx#stroke 22 | 23 | ;; 24 | 25 | D.window#_set_onload onload 26 | -------------------------------------------------------------------------------- /examples/dom/canvas/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Canvas 4 | 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/LICENSE: -------------------------------------------------------------------------------- 1 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 2 | Version 2, December 2004 3 | 4 | Copyright (C) 2004 Sam Hocevar 5 | 14 rue de Plaisance, 75014 Paris, France 6 | Everyone is permitted to copy and distribute verbatim or modified 7 | copies of this license document, and changing it is allowed as long 8 | as the name is changed. 9 | 10 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 11 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 12 | 13 | 0. You just DO WHAT THE FUCK YOU WANT TO. 14 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/Makefile: -------------------------------------------------------------------------------- 1 | JS=main.js 2 | 3 | all: myocamlbuild.ml 4 | ocamlbuild $(JS); ln -s _build/$(JS) . 5 | 6 | clean: 7 | ocamlbuild -clean 8 | rm -f myocamlbuild.ml 9 | 10 | myocamlbuild.ml: 11 | ln -s ../../../tools/myocamlbuild.ml 12 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/README: -------------------------------------------------------------------------------- 1 | This is a port of the minesweeper example from O'Browser 0.1. 2 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/_tags: -------------------------------------------------------------------------------- 1 | <*.ml>: pkg_ocamljs,pkg_dom 2 | <*.js>: pkg_ocamljs,pkg_dom 3 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | Hello world 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/main.ml: -------------------------------------------------------------------------------- 1 | let int_input name value = 2 | let d = Dom.document in 3 | let res = d#createDocumentFragment in 4 | ignore (res#appendChild (d#createTextNode name)); 5 | let input = (d#createElement "input" : Dom.input) in 6 | input#setAttribute "type" "text"; 7 | input#_set_value (string_of_int !value); 8 | input#_set_onchange 9 | (fun _ -> 10 | (value := try int_of_string input#_get_value with _ -> !value); 11 | input#_set_value (string_of_int !value)); 12 | ignore (res#appendChild input); 13 | res 14 | 15 | let button name callback = 16 | let d = Dom.document in 17 | let res = d#createDocumentFragment in 18 | let input = (d#createElement "input" : Dom.input) in 19 | input#setAttribute "type" "submit"; 20 | input#_set_value name; 21 | input#_set_onclick callback; 22 | ignore (res#appendChild input); 23 | res 24 | 25 | let div id = 26 | let div = Dom.document#createElement "div" in 27 | div#setAttribute "id" id; 28 | div 29 | 30 | let uid = let uid = ref 0 in fun () -> incr uid ; "caml__" ^ string_of_int !uid 31 | 32 | let onload _ = 33 | let d = Dom.document in 34 | let main = d#getElementById "main" in 35 | let nbr, nbc, nbm = ref 10, ref 12, ref 15 in 36 | ignore (main#appendChild (int_input "Number of columns" nbr)); 37 | ignore (main#appendChild (d#createElement "br")); 38 | ignore (main#appendChild (int_input "Number of rows" nbc)); 39 | ignore (main#appendChild (d#createElement "br")); 40 | ignore (main#appendChild (int_input "Number of mines" nbm)); 41 | ignore (main#appendChild (d#createElement "br")); 42 | ignore (main#appendChild 43 | (button "nouvelle partie" 44 | (fun _ -> 45 | let id = uid () in 46 | ignore (main#appendChild (div id)); 47 | Minesweeper.run 48 | id 49 | (string_of_int !nbc) 50 | (string_of_int !nbr) 51 | (string_of_int !nbm); 52 | false))); 53 | 54 | ;; 55 | 56 | Dom.window#_set_onload onload 57 | -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/1.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/2.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/3.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/4.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/5.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/6.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/7.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/8.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/bomb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/bomb.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/empty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/empty.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/flag.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/flag.png -------------------------------------------------------------------------------- /examples/dom/minesweeper/sprites/normal.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/minesweeper/sprites/normal.png -------------------------------------------------------------------------------- /examples/dom/planet/Makefile: -------------------------------------------------------------------------------- 1 | JS=planet.js 2 | 3 | all: myocamlbuild.ml 4 | ocamlbuild $(JS); ln -s _build/$(JS) . 5 | 6 | clean: 7 | ocamlbuild -clean 8 | rm -f myocamlbuild.ml 9 | 10 | myocamlbuild.ml: 11 | ln -s ../../../tools/myocamlbuild.ml 12 | -------------------------------------------------------------------------------- /examples/dom/planet/_tags: -------------------------------------------------------------------------------- 1 | <*.ml> : pkg_javascript, pkg_dom, pkg_lwt-dom 2 | <*.js> : pkg_javascript, pkg_dom, pkg_lwt-dom 3 | 4 | -------------------------------------------------------------------------------- /examples/dom/planet/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | Planet 7 | 16 | 17 | 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /examples/dom/planet/texture.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/examples/dom/planet/texture.jpg -------------------------------------------------------------------------------- /examples/dom/sudoku/Makefile: -------------------------------------------------------------------------------- 1 | JS=sudoku.js 2 | 3 | all: myocamlbuild.ml 4 | ocamlbuild $(JS); ln -s _build/$(JS) . 5 | 6 | clean: 7 | ocamlbuild -clean 8 | rm -f myocamlbuild.ml 9 | 10 | myocamlbuild.ml: 11 | ln -s ../../../tools/myocamlbuild.ml 12 | -------------------------------------------------------------------------------- /examples/dom/sudoku/_tags: -------------------------------------------------------------------------------- 1 | : pkg_dom 2 | : pkg_dom 3 | -------------------------------------------------------------------------------- /examples/dom/sudoku/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Sudoku 4 | 5 | 6 |

Sudoku

7 |
8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /examples/dom/sudoku/sudoku.ml: -------------------------------------------------------------------------------- 1 | module D = Dom 2 | let d = D.document 3 | 4 | let make_board () = 5 | let make_input () = 6 | let input = (d#createElement "input" : D.input) in 7 | input#setAttribute "type" "text"; 8 | input#_set_size 1; 9 | input#_set_maxLength 1; 10 | let style = input#_get_style in 11 | style#_set_border "none"; 12 | style#_set_padding "0px"; 13 | let enforce_digit () = 14 | match input#_get_value with 15 | | "1" | "2" | "3" | "4" | "5" 16 | | "6" | "7" | "8" | "9" -> () 17 | | _ -> input#_set_value "" in 18 | input#_set_onchange enforce_digit; 19 | input in 20 | 21 | let make_td i j input = 22 | let td = d#createElement "td" in 23 | let style = td#_get_style in 24 | style#_set_borderStyle "solid"; 25 | style#_set_borderColor "#000000"; 26 | let widths = function 27 | | 0 -> 2, 0 | 2 -> 1, 1 | 3 -> 1, 0 28 | | 5 -> 1, 1 | 6 -> 1, 0 | 8 -> 1, 2 29 | | _ -> 1, 0 in 30 | let (top, bottom) = widths i in 31 | let (left, right) = widths j in 32 | let px k = string_of_int k ^ "px" in 33 | style#_set_borderTopWidth (px top); 34 | style#_set_borderBottomWidth (px bottom); 35 | style#_set_borderLeftWidth (px left); 36 | style#_set_borderRightWidth (px right); 37 | ignore (td#appendChild input); 38 | td in 39 | 40 | let rows = 41 | Array.init 9 (fun i -> 42 | Array.init 9 (fun j -> 43 | make_input ())) in 44 | 45 | let table = d#createElement "table" in 46 | table#setAttribute "cellpadding" "0px"; 47 | table#setAttribute "cellspacing" "0px"; 48 | let tbody = d#createElement "tbody" in 49 | ignore (table#appendChild tbody); 50 | ArrayLabels.iteri rows ~f:(fun i row -> 51 | let tr = d#createElement "tr" in 52 | ArrayLabels.iteri row ~f:(fun j cell -> 53 | let td = make_td i j cell in 54 | ignore (tr#appendChild td)); 55 | ignore (tbody#appendChild tr)); 56 | 57 | (rows, table) 58 | 59 | let check_board rows _ = 60 | let error i j = 61 | let cell = rows.(i).(j) in 62 | cell#_get_style#_set_backgroundColor "#ff0000" in 63 | 64 | let check_set set = 65 | let seen = Array.make 9 None in 66 | ArrayLabels.iter set ~f:(fun (i,j) -> 67 | let cell = rows.(i).(j) in 68 | match cell#_get_value with 69 | | "" -> () 70 | | v -> 71 | let n = int_of_string v in 72 | match seen.(n - 1) with 73 | | None -> 74 | seen.(n - 1) <- Some (i,j) 75 | | Some (i',j') -> 76 | error i j; 77 | error i' j') in 78 | 79 | let check_row i = 80 | check_set (Array.init 9 (fun j -> (i,j))) in 81 | 82 | let check_column j = 83 | check_set (Array.init 9 (fun i -> (i,j))) in 84 | 85 | let check_square i j = 86 | let set = Array.init 9 (fun k -> 87 | i * 3 + k mod 3, j * 3 + k / 3) in 88 | check_set set in 89 | 90 | ArrayLabels.iter rows ~f:(fun row -> 91 | ArrayLabels.iter row ~f:(fun cell -> 92 | cell#_get_style#_set_backgroundColor "#ffffff")); 93 | 94 | for i = 0 to 8 do check_row i done; 95 | for j = 0 to 8 do check_column j done; 96 | for i = 0 to 2 do 97 | for j = 0 to 2 do 98 | check_square i j 99 | done 100 | done; 101 | false 102 | 103 | let onload () = 104 | let (rows, table) = make_board () in 105 | let check = d#getElementById "check" in 106 | check#_set_onclick (check_board rows); 107 | let board = d#getElementById "board" in 108 | ignore (board#appendChild table) 109 | 110 | ;; 111 | 112 | D.window#_set_onload onload 113 | -------------------------------------------------------------------------------- /examples/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | ocamljs examples 4 | 5 | 6 |

Dom

7 |

8 | Examples using the Dom library for web programming. 9 |

10 | 31 | 32 |

jQuery

33 |

34 | Examples using the jQuery binding. 35 |

36 | 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /examples/jquery/Makefile: -------------------------------------------------------------------------------- 1 | DIRS=live_examples 2 | 3 | all: 4 | for dir in $(DIRS); do \ 5 | $(MAKE) -C $$dir all || exit; \ 6 | done 7 | 8 | clean: 9 | for dir in $(DIRS); do \ 10 | $(MAKE) -C $$dir clean || exit; \ 11 | done 12 | -------------------------------------------------------------------------------- /examples/jquery/live_examples/Makefile: -------------------------------------------------------------------------------- 1 | JS=live_examples.js 2 | 3 | all: myocamlbuild.ml 4 | ocamlbuild $(JS); ln -s _build/$(JS) . 5 | 6 | clean: 7 | ocamlbuild -clean 8 | rm -f myocamlbuild.ml 9 | 10 | myocamlbuild.ml: 11 | ln -s ../../../tools/myocamlbuild.ml 12 | -------------------------------------------------------------------------------- /examples/jquery/live_examples/_tags: -------------------------------------------------------------------------------- 1 | : syntax_camlp4o,pkg_jquery.syntax,pkg_ocamljs,pkg_dom,pkg_jquery 2 | : pkg_ocamljs,pkg_dom,pkg_jquery 3 | -------------------------------------------------------------------------------- /examples/jquery/live_examples/live_examples.ml: -------------------------------------------------------------------------------- 1 | open JQuery 2 | open Dom 3 | 4 | let () = jQuery_ready 5 | begin fun (~$) -> 6 | 7 | (* Code for example A *) 8 | ~$"input.buttonAsize"#click 9 | (fun _ -> 10 | let size = ~$"div.contentToChange" #find "p" #size in 11 | window#alert (string_of_int size); 12 | false); 13 | (* Show code example A *) 14 | ~$"a.codeButtonA"#click (fun _ -> ~$"pre.codeA"#toggle; false); 15 | 16 | (* Code for example B *) 17 | ~$"input.buttonBslidedown"#click 18 | (fun _ -> 19 | ~$"div.contentToChange"#find "p.firstparagraph:hidden" 20 | #slideDown_speed_ "slow" ignore; 21 | false); 22 | ~$"input.buttonBslideup"#click 23 | (fun _ -> 24 | ~$"div.contentToChange"#find "p.firstparagraph:visible" 25 | #slideUp_speed_ "slow" ignore; 26 | false); 27 | (* Show code example B *) 28 | ~$"a.codeButtonB"#click (fun _ -> ~$"pre.codeB"#toggle; false); 29 | 30 | (* Code for example C *) 31 | ~$"input.buttonCAdd"#click 32 | (fun _ -> 33 | ~$"div.contentToChange" #find "p" #not ".alert" 34 | #append " This text was just appended to this paragraph"; 35 | false); 36 | ~$"input.buttonCRemove"#click 37 | (fun _ -> 38 | ~$"strong.addedtext"#remove; 39 | false); 40 | (* Show code example C *) 41 | ~$"a.codeButtonC"#click (fun _ -> ~$"pre.codeC"#toggle; false); 42 | 43 | (* Code for example D *) 44 | ~$"input.buttonDhide"#click 45 | (fun _ -> 46 | ~$"div.contentToChange"#find "p.thirdparagraph" 47 | #hide_speed_ "slow" ignore; 48 | false); 49 | (* Show code example D *) 50 | ~$"a.codeButtonD"#click (fun _ -> ~$"pre.codeD"#toggle; false); 51 | 52 | (* Code for example E *) 53 | ~$"input.buttonEitalics"#click 54 | (fun _ -> 55 | ~$"div.contentToChange" #find "em" #css_obj_ 56 | (object 57 | method color = "#993300" 58 | method fontWeight = "bold" 59 | end); 60 | false); 61 | (* Show code example E *) 62 | ~$"a.codeButtonE"#click (fun _ -> ~$"pre.codeE"#toggle; false); 63 | 64 | (* Code for example F *) 65 | ~$"input.buttonFaddclass"#click 66 | (fun _ -> ~$"p.fifthparagraph"#addClass "changeP"; false); 67 | ~$"input.buttonFremoveclass"#click 68 | (fun _ -> ~$"p.fifthparagraph"#removeClass "changeP"; false); 69 | (* Show code example F *) 70 | ~$"a.codeButtonF"#click (fun _ -> ~$"pre.codeF"#toggle; false); 71 | 72 | end 73 | -------------------------------------------------------------------------------- /examples/jslib/ppp/Makefile: -------------------------------------------------------------------------------- 1 | all: myocamlbuild.ml 2 | ocamlbuild ppp.byte 3 | 4 | clean: 5 | ocamlbuild -clean 6 | rm -f myocamlbuild.ml 7 | 8 | myocamlbuild.ml: 9 | ln -s ../../../tools/myocamlbuild.ml 10 | -------------------------------------------------------------------------------- /examples/jslib/ppp/_tags: -------------------------------------------------------------------------------- 1 | <*.ml>: pkg_jslib 2 | <*.byte>: pkg_jslib 3 | -------------------------------------------------------------------------------- /examples/jslib/ppp/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | (* ocamlfind integration following http://www.nabble.com/forum/ViewPost.jtp?post=15979274 *) 4 | 5 | (* these functions are not really officially exported *) 6 | let run_and_read = Ocamlbuild_pack.My_unix.run_and_read 7 | let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings 8 | 9 | (* this lists all supported packages *) 10 | let find_packages () = 11 | blank_sep_strings & 12 | Lexing.from_string & 13 | run_and_read "ocamlfind list | cut -d' ' -f1" 14 | 15 | (* this is supposed to list available syntaxes, but I don't know how to do it. *) 16 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 17 | 18 | (* ocamlfind command *) 19 | let ocamlfind x = S[A"ocamlfind"; x] 20 | 21 | ;; 22 | 23 | dispatch begin function 24 | | Before_options -> 25 | 26 | (* override default commands by ocamlfind ones *) 27 | Options.ocamlc := ocamlfind & A"ocamlc"; 28 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 29 | Options.ocamldep := ocamlfind & A"ocamldep"; 30 | Options.ocamldoc := ocamlfind & A"ocamldoc" 31 | 32 | | After_rules -> 33 | 34 | (* When one link an OCaml library/binary/package, one should use -linkpkg *) 35 | flag ["ocaml"; "link"] & A"-linkpkg"; 36 | 37 | (* For each ocamlfind package one inject the -package option when 38 | * compiling, computing dependencies, generating documentation and 39 | * linking. *) 40 | List.iter begin fun pkg -> 41 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; 42 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; 43 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; 44 | flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; 45 | end (find_packages ()); 46 | 47 | (* Like -package but for extensions syntax. Morover -syntax is useless 48 | * when linking. *) 49 | List.iter begin fun syntax -> 50 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 51 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 52 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 53 | end (find_syntaxes ()); 54 | 55 | | _ -> () 56 | end 57 | -------------------------------------------------------------------------------- /examples/jslib/ppp/ppp.ml: -------------------------------------------------------------------------------- 1 | (* parse and pretty print Javascript *) 2 | 3 | Format.set_margin 25; 4 | try 5 | let ss = Jslib_parse.parse_stdin () in 6 | Jslib_pp.stmt Format.std_formatter ss; 7 | Format.fprintf Format.std_formatter "\n"; 8 | Format.pp_print_flush Format.std_formatter () 9 | with e -> 10 | Format.eprintf "@[%a@]@." Camlp4.ErrorHandler.print e 11 | -------------------------------------------------------------------------------- /examples/jslib/ppp/test.js: -------------------------------------------------------------------------------- 1 | function foo (x, y, z) { 2 | return [1, 2, 3], true, x = y; 3 | return a + b * (c + d); 4 | } 5 | -------------------------------------------------------------------------------- /examples/jslib/quot/Makefile: -------------------------------------------------------------------------------- 1 | all: myocamlbuild.ml 2 | ocamlbuild quot.byte 3 | 4 | clean: 5 | ocamlbuild -clean 6 | rm -f myocamlbuild.ml 7 | 8 | myocamlbuild.ml: 9 | ln -s ../../../tools/myocamlbuild.ml 10 | -------------------------------------------------------------------------------- /examples/jslib/quot/_tags: -------------------------------------------------------------------------------- 1 | <*.ml>: syntax_camlp4o,pkg_jslib 2 | <*.byte>: pkg_jslib 3 | -------------------------------------------------------------------------------- /examples/jslib/quot/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | (* ocamlfind integration following http://www.nabble.com/forum/ViewPost.jtp?post=15979274 *) 4 | 5 | (* these functions are not really officially exported *) 6 | let run_and_read = Ocamlbuild_pack.My_unix.run_and_read 7 | let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings 8 | 9 | (* this lists all supported packages *) 10 | let find_packages () = 11 | blank_sep_strings & 12 | Lexing.from_string & 13 | run_and_read "ocamlfind list | cut -d' ' -f1" 14 | 15 | (* this is supposed to list available syntaxes, but I don't know how to do it. *) 16 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 17 | 18 | (* ocamlfind command *) 19 | let ocamlfind x = S[A"ocamlfind"; x] 20 | 21 | ;; 22 | 23 | dispatch begin function 24 | | Before_options -> 25 | 26 | (* override default commands by ocamlfind ones *) 27 | Options.ocamlc := ocamlfind & A"ocamlc"; 28 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 29 | Options.ocamldep := ocamlfind & A"ocamldep"; 30 | Options.ocamldoc := ocamlfind & A"ocamldoc" 31 | 32 | | After_rules -> 33 | 34 | (* When one link an OCaml library/binary/package, one should use -linkpkg *) 35 | flag ["ocaml"; "link"] & A"-linkpkg"; 36 | 37 | (* For each ocamlfind package one inject the -package option when 38 | * compiling, computing dependencies, generating documentation and 39 | * linking. *) 40 | List.iter begin fun pkg -> 41 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; 42 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; 43 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; 44 | flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; 45 | end (find_packages ()); 46 | 47 | (* Like -package but for extensions syntax. Morover -syntax is useless 48 | * when linking. *) 49 | List.iter begin fun syntax -> 50 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 51 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 52 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 53 | end (find_syntaxes ()); 54 | 55 | | _ -> () 56 | end 57 | -------------------------------------------------------------------------------- /examples/jslib/quot/quot.ml: -------------------------------------------------------------------------------- 1 | (* pretty print Javascript from a quotation *) 2 | 3 | let _loc = Camlp4.PreCast.Loc.ghost 4 | 5 | let ss = [ 6 | <:stmt< return foo(); >>; 7 | <:stmt< return new Foo; >>; 8 | <:stmt< return new Foo(); >>; 9 | ] in 10 | 11 | List.iter (fun s -> 12 | Jslib_pp.stmt Format.std_formatter s; 13 | Format.fprintf Format.std_formatter "\n") ss; 14 | Format.pp_print_flush Format.std_formatter () 15 | -------------------------------------------------------------------------------- /src/dom/META: -------------------------------------------------------------------------------- 1 | name="DOM" 2 | version="0.3" 3 | description="Generic DOM bindings" 4 | requires = "ocamljs" 5 | archive(js) = "dom.cmjsa" 6 | -------------------------------------------------------------------------------- /src/dom/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | FILES=\ 4 | dom.cmjsa \ 5 | dom.mli dom.cmi 6 | 7 | BFILES=$(addprefix _build/,$(FILES)) 8 | 9 | all: myocamlbuild.ml 10 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 11 | OCAMLPATH=`pwd`/../../stage \ 12 | ocamlbuild dom.cmjsa 13 | ocamlfind remove -destdir ../../stage dom 14 | ocamlfind install -destdir ../../stage dom META $(BFILES) 15 | 16 | doc: 17 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 18 | OCAMLPATH=`pwd`/../../stage \ 19 | ocamlbuild -no-links doc.docdir/index.html 20 | 21 | install: 22 | ocamlfind install dom META $(BFILES) 23 | 24 | uninstall: 25 | ocamlfind remove dom 26 | 27 | clean: 28 | ocamlbuild -clean 29 | rm -f myocamlbuild.ml 30 | 31 | myocamlbuild.ml: 32 | ln -s ../../tools/myocamlbuild.ml . 33 | -------------------------------------------------------------------------------- /src/dom/_tags: -------------------------------------------------------------------------------- 1 | <*.ml*> : pkg_ocamljs 2 | -------------------------------------------------------------------------------- /src/dom/doc.odocl: -------------------------------------------------------------------------------- 1 | Dom 2 | -------------------------------------------------------------------------------- /src/dom/dom.mllib: -------------------------------------------------------------------------------- 1 | Dom 2 | -------------------------------------------------------------------------------- /src/gmaps/META: -------------------------------------------------------------------------------- 1 | name="Gmaps" 2 | version="0.3" 3 | description="Google Maps binding" 4 | requires = "ocamljs,dom" 5 | archive(js) = "gmaps.cmjsa" 6 | -------------------------------------------------------------------------------- /src/gmaps/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | FILES=\ 4 | gmaps.cmjsa \ 5 | gmaps.mli gmaps.cmi 6 | 7 | BFILES=$(addprefix _build/,$(FILES)) 8 | 9 | all: myocamlbuild.ml 10 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 11 | OCAMLPATH=`pwd`/../../stage \ 12 | ocamlbuild gmaps.cmjsa 13 | 14 | doc: 15 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 16 | OCAMLPATH=`pwd`/../../stage \ 17 | ocamlbuild -no-links doc.docdir/index.html 18 | 19 | install: 20 | ocamlfind install gmaps META $(BFILES) 21 | 22 | uninstall: 23 | ocamlfind remove gmaps 24 | 25 | clean: 26 | ocamlbuild -clean 27 | rm -f myocamlbuild.ml 28 | 29 | myocamlbuild.ml: 30 | ln -s ../../tools/myocamlbuild.ml . 31 | -------------------------------------------------------------------------------- /src/gmaps/_tags: -------------------------------------------------------------------------------- 1 | <*.ml*> : pkg_ocamljs,pkg_javascript,pkg_dom 2 | 3 | -------------------------------------------------------------------------------- /src/gmaps/doc.odocl: -------------------------------------------------------------------------------- 1 | Gmaps 2 | -------------------------------------------------------------------------------- /src/gmaps/gmaps.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2009 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | class type gLatLng = 23 | object 24 | end 25 | 26 | external new_GLatLng : float -> float -> gLatLng = "$new" "GLatLng" 27 | 28 | class type gLatLngBounds = 29 | object 30 | end 31 | 32 | external new_GLatLngBounds : gLatLng -> gLatLng -> gLatLngBounds = "$new" "GLatLngBounds" 33 | 34 | class type gCopyright = 35 | object 36 | end 37 | 38 | external new_GCopyright : string -> gLatLngBounds -> int -> string -> gCopyright = "$new" "GCopyright" 39 | 40 | class type gCopyrightCollection = 41 | object 42 | method addCopyright : gCopyright -> unit 43 | end 44 | 45 | external new_GCopyrightCollection : unit -> gCopyrightCollection = "$new" "GCopyrightCollection" 46 | 47 | class type gPoint = 48 | object 49 | method _get_x : int 50 | method _get_y : int 51 | end 52 | 53 | external new_GPoint : int -> int -> gPoint = "$new" "GPoint" 54 | 55 | class type gSize = 56 | object 57 | end 58 | 59 | external new_GSize : int -> int -> gSize = "$new" "GSize" 60 | 61 | class type gIcon = 62 | object 63 | method _set_image : string -> unit 64 | method _set_shadow : string -> unit 65 | method _set_iconSize : gSize -> unit 66 | method _set_shadowSize : gSize -> unit 67 | method _set_iconAnchor : gPoint -> unit 68 | method _set_infoWindowAnchor : gPoint -> unit 69 | end 70 | 71 | external new_GIcon : unit -> gIcon = "$new" "GIcon" 72 | 73 | class type gOverlay = 74 | object 75 | end 76 | 77 | class type gMap2 = 78 | object 79 | method setCenter_zoom_ : gLatLng -> int -> unit 80 | method addOverlay : #gOverlay -> unit 81 | method panTo : gLatLng -> unit 82 | end 83 | 84 | external new_GMap2 : Dom.element -> gMap2 = "$new" "GMap2" 85 | 86 | class type gTileLayer = 87 | object 88 | method _set_getTileUrl : (gPoint -> int -> string) -> unit 89 | method _set_isPng : (unit -> bool) -> unit 90 | method _set_getOpacity : (unit -> float) -> unit 91 | end 92 | 93 | external new_GTileLayer : gCopyrightCollection -> int -> int -> gTileLayer = "$new" "GTileLayer" 94 | 95 | class type gTileLayerOverlay = 96 | object 97 | inherit gOverlay 98 | end 99 | 100 | external new_GTileLayerOverlay : gTileLayer -> gTileLayerOverlay = "$new" "GTileLayerOverlay" 101 | 102 | class type gMarker = 103 | object 104 | inherit gOverlay 105 | 106 | method openInfoWindow : #Dom.node -> unit 107 | method openInfoWindow_string_ : string -> unit 108 | end 109 | 110 | external new_GMarker : gLatLng -> gIcon -> gMarker = "$new" "GMarker" 111 | -------------------------------------------------------------------------------- /src/gmaps/gmaps.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2009 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (** Google Maps binding *) 23 | (** 24 | [Gmaps] is a binding of the Google Maps API. 25 | *) 26 | 27 | class type gLatLng = 28 | object 29 | end 30 | 31 | external new_GLatLng : float -> float -> gLatLng = "$new" "GLatLng" 32 | 33 | class type gLatLngBounds = 34 | object 35 | end 36 | 37 | external new_GLatLngBounds : gLatLng -> gLatLng -> gLatLngBounds = "$new" "GLatLngBounds" 38 | 39 | class type gCopyright = 40 | object 41 | end 42 | 43 | external new_GCopyright : string -> gLatLngBounds -> int -> string -> gCopyright = "$new" "GCopyright" 44 | 45 | class type gCopyrightCollection = 46 | object 47 | method addCopyright : gCopyright -> unit 48 | end 49 | 50 | external new_GCopyrightCollection : unit -> gCopyrightCollection = "$new" "GCopyrightCollection" 51 | 52 | class type gPoint = 53 | object 54 | method _get_x : int 55 | method _get_y : int 56 | end 57 | 58 | external new_GPoint : int -> int -> gPoint = "$new" "GPoint" 59 | 60 | class type gSize = 61 | object 62 | end 63 | 64 | external new_GSize : int -> int -> gSize = "$new" "GSize" 65 | 66 | class type gIcon = 67 | object 68 | method _set_image : string -> unit 69 | method _set_shadow : string -> unit 70 | method _set_iconSize : gSize -> unit 71 | method _set_shadowSize : gSize -> unit 72 | method _set_iconAnchor : gPoint -> unit 73 | method _set_infoWindowAnchor : gPoint -> unit 74 | end 75 | 76 | external new_GIcon : unit -> gIcon = "$new" "GIcon" 77 | 78 | class type gOverlay = 79 | object 80 | end 81 | 82 | class type gMap2 = 83 | object 84 | method setCenter_zoom_ : gLatLng -> int -> unit 85 | method addOverlay : #gOverlay -> unit 86 | method panTo : gLatLng -> unit 87 | end 88 | 89 | external new_GMap2 : Dom.element -> gMap2 = "$new" "GMap2" 90 | 91 | class type gTileLayer = 92 | object 93 | method _set_getTileUrl : (gPoint -> int -> string) -> unit 94 | method _set_isPng : (unit -> bool) -> unit 95 | method _set_getOpacity : (unit -> float) -> unit 96 | end 97 | 98 | external new_GTileLayer : gCopyrightCollection -> int -> int -> gTileLayer = "$new" "GTileLayer" 99 | 100 | class type gTileLayerOverlay = 101 | object 102 | inherit gOverlay 103 | end 104 | 105 | external new_GTileLayerOverlay : gTileLayer -> gTileLayerOverlay = "$new" "GTileLayerOverlay" 106 | 107 | class type gMarker = 108 | object 109 | inherit gOverlay 110 | 111 | method openInfoWindow : #Dom.node -> unit 112 | method openInfoWindow_string_ : string -> unit 113 | end 114 | 115 | external new_GMarker : gLatLng -> gIcon -> gMarker = "$new" "GMarker" 116 | -------------------------------------------------------------------------------- /src/gmaps/gmaps.mllib: -------------------------------------------------------------------------------- 1 | Gmaps 2 | -------------------------------------------------------------------------------- /src/javascript/META: -------------------------------------------------------------------------------- 1 | name="Javascript" 2 | description="Javascript API bindings" 3 | version="0.3" 4 | requires = "ocamljs" 5 | archive(js) = "javascript.cmjs" 6 | -------------------------------------------------------------------------------- /src/javascript/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 5 | OCAMLPATH=`pwd`/../../stage \ 6 | ocamlbuild javascript.cmjs 7 | ocamlfind remove -destdir ../../stage javascript 8 | ocamlfind install -destdir ../../stage javascript META _build/*.cmi _build/*.cmjs 9 | 10 | doc: 11 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 12 | OCAMLPATH=`pwd`/../../stage \ 13 | ocamlbuild -no-links doc.docdir/index.html 14 | 15 | install: 16 | ocamlfind install javascript META _build/*.cmi _build/*.cmjs 17 | 18 | uninstall: 19 | ocamlfind remove javascript 20 | 21 | clean: 22 | ocamlbuild -clean 23 | rm -f myocamlbuild.ml 24 | 25 | myocamlbuild.ml: 26 | ln -s ../../tools/myocamlbuild.ml 27 | -------------------------------------------------------------------------------- /src/javascript/_tags: -------------------------------------------------------------------------------- 1 | : syntax_camlp4o,pkg_jslib.inline,pkg_ocamljs 2 | -------------------------------------------------------------------------------- /src/javascript/doc.odocl: -------------------------------------------------------------------------------- 1 | Javascript 2 | -------------------------------------------------------------------------------- /src/jquery/META: -------------------------------------------------------------------------------- 1 | name="jQuery" 2 | version="0.1" 3 | description="jQuery binding" 4 | requires = "ocamljs,dom" 5 | archive(js) = "jquery.cmjsa" 6 | 7 | package "syntax" ( 8 | exists_if = "pa_jquery.cmo" 9 | description = "Syntax extension to support method chaining" 10 | requires = "camlp4" 11 | archive(syntax,preprocessor) = "pa_jquery.cmo" 12 | archive(syntax,toploop) = "pa_jquery.cmo" 13 | ) 14 | -------------------------------------------------------------------------------- /src/jquery/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | FILES=\ 4 | jquery.cmjsa \ 5 | jQuery.mli jQuery.cmi \ 6 | pa_jquery.cmo 7 | 8 | BFILES=$(addprefix _build/,$(FILES)) 9 | 10 | all: myocamlbuild.ml 11 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 12 | OCAMLPATH=`pwd`/../../stage \ 13 | ocamlbuild jquery.cmjsa pa_jquery.cmo 14 | 15 | doc: 16 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 17 | OCAMLPATH=`pwd`/../../stage \ 18 | ocamlbuild -no-links doc.docdir/index.html 19 | 20 | install: 21 | ocamlfind install jquery META $(BFILES) 22 | 23 | uninstall: 24 | ocamlfind remove jquery 25 | 26 | clean: 27 | ocamlbuild -clean 28 | rm -f myocamlbuild.ml 29 | 30 | myocamlbuild.ml: 31 | ln -s ../../tools/myocamlbuild.ml . 32 | -------------------------------------------------------------------------------- /src/jquery/_tags: -------------------------------------------------------------------------------- 1 | : pkg_dom 2 | : syntax_camlp4o,pkg_camlp4.quotations,pkg_camlp4.extend 3 | -------------------------------------------------------------------------------- /src/jquery/doc.odocl: -------------------------------------------------------------------------------- 1 | JQuery 2 | -------------------------------------------------------------------------------- /src/jquery/jquery.mllib: -------------------------------------------------------------------------------- 1 | JQuery 2 | -------------------------------------------------------------------------------- /src/jquery/pa_jquery.ml: -------------------------------------------------------------------------------- 1 | open Camlp4 2 | 3 | module Id : Sig.Id = 4 | struct 5 | let name = "pa_jquery" 6 | let version = "0.1" 7 | end 8 | 9 | module Make (Syntax : Sig.Camlp4Syntax) = 10 | struct 11 | open Sig 12 | include Syntax 13 | 14 | DELETE_RULE Gram expr: SELF; "#"; label END; 15 | 16 | EXTEND Gram 17 | expr: BEFORE "apply" 18 | [ "#" LEFTA 19 | [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] 20 | ]; 21 | END 22 | end 23 | 24 | let module M = Register.OCamlSyntaxExtension(Id)(Make) in () 25 | -------------------------------------------------------------------------------- /src/jscomp/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | ML=translcore.ml translobj.ml translclass.ml typecore.ml 4 | MLI=$(addsuffix .mli,$(basename $(ML))) 5 | 6 | all: myocamlbuild.ml ocaml $(ML) $(MLI) prereqs ocamljs # ocamljs.opt 7 | 8 | %.ml : patches/$(OCAML_VERSION)/%.ml.patch 9 | if [ -f ocaml/bytecomp/$@ ]; then cp ocaml/bytecomp/$@ .; \ 10 | elif [ -f ocaml/typing/$@ ]; then cp ocaml/typing/$@ .; \ 11 | fi 12 | patch $@ $< 13 | 14 | %.mli : 15 | if [ -f ocaml/bytecomp/$@ ]; then ln -s ocaml/bytecomp/$@ .; \ 16 | elif [ -f ocaml/typing/$@ ]; then ln -s ocaml/typing/$@ .; \ 17 | fi 18 | 19 | doc: 20 | 21 | prereqs: 22 | ./ocaml/build/mkmyocamlbuild_config.sh 23 | $(MAKE) -C ocaml/byterun primitives # how does this get built for regular OCaml? 24 | 25 | ocamljs: 26 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR) \ 27 | OCAMLPATH=`pwd`/../../stage \ 28 | ocamlbuild $(OCAMLBUILD_FLAGS) jsmain.byte 29 | 30 | # not sure how to get this to link 31 | ocamljs.opt: 32 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR) \ 33 | OCAMLPATH=`pwd`/../jslib/_build \ 34 | ocamlbuild $(OCAMLBUILD_FLAGS) jsmain.native 35 | 36 | install: 37 | install _build/jsmain.byte $(BINDIR)/ocamljs 38 | # install _build/jsmain.native $(BINDIR)/ocamljs.opt 39 | 40 | uninstall: 41 | rm -f $(BINDIR)/ocamljs 42 | # rm -f $(BINDIR)/ocamljs.opt 43 | 44 | clean: 45 | ocamlbuild -clean 46 | rm -f ocaml 47 | rm -f myocamlbuild.ml 48 | rm -f $(ML) $(MLI) 49 | 50 | myocamlbuild.ml: ../../tools/myocamlbuild.ml myocamlbuild.mlp 51 | cat ../../tools/myocamlbuild.ml myocamlbuild.mlp > myocamlbuild.ml 52 | 53 | ocaml: 54 | ln -s ../../ocaml . 55 | 56 | patches: 57 | for ver in $(VERSIONS); do \ 58 | $(MAKE) -C patches/$$ver patches || exit; \ 59 | done 60 | 61 | .PHONY: patches 62 | -------------------------------------------------------------------------------- /src/jscomp/_tags: -------------------------------------------------------------------------------- 1 | or or or or or : syntax_camlp4o,pkg_camlp4.macro 2 | : pkg_jslib 3 | : pkg_jslib 4 | : pkg_jslib 5 | : syntax_camlp4o,pkg_jslib.quotations,pkg_jslib.lambda 6 | : syntax_camlp4o,pkg_jslib.lambda 7 | : pkg_jslib 8 | : pkg_jslib 9 | 10 | : pkg_jslib 11 | -------------------------------------------------------------------------------- /src/jscomp/emitjs.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/emitcode.ml in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | open Config 17 | open Ocamljs_config 18 | open Misc 19 | open Asttypes 20 | open Lambda 21 | open Instruct 22 | open Opcodes 23 | open Cmo_format 24 | 25 | (* Emission to a file *) 26 | 27 | let to_file outchan unit_name (code, reloc) = 28 | output_string outchan cmjs_magic_number; 29 | let pos_depl = pos_out outchan in 30 | output_binary_int outchan 0; 31 | let pos_code = pos_out outchan in 32 | output_value outchan code; (* just marshal the AST *) 33 | let codesize = pos_out outchan - pos_code in 34 | 35 | let compunit = 36 | { cu_name = unit_name; 37 | cu_pos = pos_code; 38 | cu_codesize = codesize; 39 | cu_reloc = List.rev reloc; 40 | cu_imports = Env.imported_units(); 41 | cu_primitives = 42 | List.map Primitive.byte_name !Translmod.primitive_declarations; 43 | cu_force_link = false; 44 | cu_debug = 0; 45 | cu_debugsize = 0 } in 46 | Btype.cleanup_abbrev (); (* Remove any cached abbreviation 47 | expansion before saving *) 48 | let pos_compunit = pos_out outchan in 49 | output_value outchan compunit; 50 | seek_out outchan pos_depl; 51 | output_binary_int outchan pos_compunit 52 | 53 | let to_packed_file outchan code = 54 | output_value outchan code; 55 | [] 56 | -------------------------------------------------------------------------------- /src/jscomp/emitjs.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/emitcode.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Generation of Javascript for .cmjs files *) 17 | 18 | open Cmo_format 19 | 20 | val to_file: out_channel -> string -> (Jslib_ast.stmt * (reloc_info * int) list) -> unit 21 | val to_packed_file: out_channel -> Jslib_ast.stmt -> (reloc_info * int) list 22 | -------------------------------------------------------------------------------- /src/jscomp/jscompile.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (driver/compile.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Compile a .ml or .mli file *) 17 | 18 | open Format 19 | 20 | val interface: formatter -> string -> string -> unit 21 | val implementation: formatter -> string -> string -> unit 22 | 23 | val initial_env: unit -> Env.t 24 | val init_path: unit -> unit 25 | -------------------------------------------------------------------------------- /src/jscomp/jserrors.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (driver/errors.ml in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* WARNING: if you change something in this file, you must look at 17 | opterrors.ml to see if you need to make the same changes there. 18 | *) 19 | 20 | open Format 21 | 22 | (* Report an error *) 23 | 24 | module Location = 25 | struct 26 | let print ppf loc = Location.print_error ppf loc; 27 | end 28 | 29 | let report_error ppf exn = 30 | let report ppf = function 31 | | Lexer.Error(err, loc) -> 32 | Location.print ppf loc; 33 | Lexer.report_error ppf err 34 | | Syntaxerr.Error err -> 35 | Syntaxerr.report_error ppf err 36 | | Pparse.Error -> 37 | fprintf ppf "Preprocessor error" 38 | | Env.Error err -> 39 | Env.report_error ppf err 40 | | Ctype.Tags(l, l') -> fprintf ppf 41 | "In this program,@ variant constructors@ `%s and `%s@ \ 42 | have the same hash value.@ Change one of them." l l' 43 | | Typecore.Error(loc, err) -> 44 | Location.print ppf loc; Typecore.report_error ppf err 45 | | Typetexp.Error(loc, err) -> 46 | Location.print ppf loc; Typetexp.report_error ppf err 47 | | Typedecl.Error(loc, err) -> 48 | Location.print ppf loc; Typedecl.report_error ppf err 49 | | Typeclass.Error(loc, err) -> 50 | Location.print ppf loc; Typeclass.report_error ppf err 51 | | Includemod.Error err -> 52 | Includemod.report_error ppf err 53 | | Typemod.Error(loc, err) -> 54 | Location.print ppf loc; Typemod.report_error ppf err 55 | | Translcore.Error(loc, err) -> 56 | Location.print ppf loc; Translcore.report_error ppf err 57 | | Translclass.Error(loc, err) -> 58 | Location.print ppf loc; Translclass.report_error ppf err 59 | | Translmod.Error(loc, err) -> 60 | Location.print ppf loc; Translmod.report_error ppf err 61 | | Symtable.Error code -> 62 | Symtable.report_error ppf code 63 | | Jslink.Error code -> 64 | Jslink.report_error ppf code 65 | | Jslibrarian.Error code -> 66 | Jslibrarian.report_error ppf code 67 | | Jspackager.Error code -> 68 | Jspackager.report_error ppf code 69 | | Sys_error msg -> 70 | fprintf ppf "I/O error: %s" msg 71 | | Warnings.Errors (n) -> 72 | fprintf ppf "@.Error: error-enabled warnings (%d occurrences)" n 73 | | x -> fprintf ppf "@]"; raise x in 74 | 75 | fprintf ppf "@[%a@]@." report exn 76 | -------------------------------------------------------------------------------- /src/jscomp/jserrors.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (driver/errors.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Error report *) 17 | open Format 18 | 19 | val report_error: formatter -> exn -> unit 20 | -------------------------------------------------------------------------------- /src/jscomp/jsgen.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/bytegen.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Generation of bytecode from lambda terms *) 17 | 18 | open Lambda 19 | open Cmo_format 20 | 21 | val compile_implementation: string -> lambda -> (Jslib_ast.stmt * (reloc_info * int) list) 22 | val jsident_of_ident : Ident.t -> string 23 | -------------------------------------------------------------------------------- /src/jscomp/jslibrarian.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/bytelibrarian.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Build libraries of .cmo files *) 17 | 18 | (* Format of a library file: 19 | magic number (Config.cma_magic_number) 20 | absolute offset of content table 21 | blocks of relocatable bytecode 22 | content table = list of compilation units 23 | *) 24 | 25 | val create_archive: string list -> string -> unit 26 | 27 | type error = 28 | File_not_found of string 29 | | Not_an_object_file of string 30 | 31 | exception Error of error 32 | 33 | open Format 34 | 35 | val report_error: formatter -> error -> unit 36 | -------------------------------------------------------------------------------- /src/jscomp/jslink.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/bytelink.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* Link .cmjs files and produce a Javascript executable. *) 17 | 18 | val link: string list -> string -> unit 19 | 20 | val check_consistency: string -> Cmo_format.compilation_unit -> unit 21 | 22 | val extract_crc_interfaces: unit -> (string * Digest.t) list 23 | 24 | type error = 25 | File_not_found of string 26 | | Not_an_object_file of string 27 | | Symbol_error of string * Symtable.error 28 | | Inconsistent_import of string * string * string 29 | | File_exists of string 30 | 31 | exception Error of error 32 | 33 | open Format 34 | 35 | val report_error: formatter -> error -> unit 36 | 37 | val patch : bool ref 38 | -------------------------------------------------------------------------------- /src/jscomp/jsmain.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (driver/main.mli in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* 17 | this "empty" file is here to speed up garbage collection in ocamlc.opt 18 | *) 19 | -------------------------------------------------------------------------------- /src/jscomp/jsmain_args.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (driver/main_args.mli) in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | module Make_options (F : 17 | sig 18 | val _a : unit -> unit 19 | val _annot : unit -> unit 20 | val _c : unit -> unit 21 | val _cclib : string -> unit 22 | val _ccopt : string -> unit 23 | val _config : unit -> unit 24 | val _custom : unit -> unit 25 | val _dllib : string -> unit 26 | val _dllpath : string -> unit 27 | val _g : unit -> unit 28 | val _i : unit -> unit 29 | val _I : string -> unit 30 | val _impl : string -> unit 31 | val _intf : string -> unit 32 | val _intf_suffix : string -> unit 33 | val _labels : unit -> unit 34 | val _linkall : unit -> unit 35 | val _make_runtime : unit -> unit 36 | val _noassert : unit -> unit 37 | val _noautolink : unit -> unit 38 | val _nolabels : unit -> unit 39 | val _nostdlib : unit -> unit 40 | val _o : string -> unit 41 | val _output_obj : unit -> unit 42 | val _pack : unit -> unit 43 | val _patch : unit -> unit 44 | val _pp : string -> unit 45 | val _principal : unit -> unit 46 | val _rectypes : unit -> unit 47 | val _thread : unit -> unit 48 | val _vmthread : unit -> unit 49 | val _unsafe : unit -> unit 50 | val _use_prims : string -> unit 51 | val _use_runtime : string -> unit 52 | val _v : unit -> unit 53 | val _version : unit -> unit 54 | val _verbose : unit -> unit 55 | val _w : string -> unit 56 | val _warn_error : string -> unit 57 | val _where : unit -> unit 58 | 59 | val _nopervasives : unit -> unit 60 | val _dparsetree : unit -> unit 61 | val _drawlambda : unit -> unit 62 | val _dlambda : unit -> unit 63 | val _dinstr : unit -> unit 64 | val anonymous : string -> unit 65 | end) : 66 | sig 67 | val list : (string * Arg.spec * string) list 68 | end 69 | -------------------------------------------------------------------------------- /src/jscomp/jspackager.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * Original file (bytecomp/bytepackager.mli) in the Objective Caml source 6 | * distribution) is Copyright (C) INRIA. 7 | * 8 | * This program is free software released under the QPL. 9 | * See LICENSE for more details. 10 | * 11 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | * FITNESS FOR A PARTICULAR PURPOSE. 14 | *) 15 | 16 | (* "Package" a set of .cmo files into one .cmo file having the 17 | original compilation units as sub-modules. *) 18 | 19 | val package_files: string list -> string -> unit 20 | 21 | type error = 22 | Forward_reference of string * Ident.t 23 | | Multiple_definition of string * Ident.t 24 | | Not_an_object_file of string 25 | | Illegal_renaming of string * string 26 | | File_not_found of string 27 | 28 | exception Error of error 29 | 30 | val report_error: Format.formatter -> error -> unit 31 | -------------------------------------------------------------------------------- /src/jscomp/myocamlbuild.mlp: -------------------------------------------------------------------------------- 1 | Pathname.define_context "." ["."; "ocaml/bytecomp"; "ocaml/driver"; "ocaml/parsing"; "ocaml/typing"; "ocaml/utils"]; 2 | Pathname.define_context "ocaml/bytecomp" ["."; "ocaml/bytecomp"; "ocaml/parsing"; "ocaml/typing"; "ocaml/utils"]; 3 | Pathname.define_context "ocaml/driver" ["ocaml/parsing"; "ocaml/utils"]; 4 | Pathname.define_context "ocaml/parsing" ["ocaml/utils"]; 5 | Pathname.define_context "ocaml/typing" ["."; "ocaml/typing"; "ocaml/parsing"; "ocaml/utils"]; 6 | Pathname.define_context "ocaml/utils" ["ocaml"]; 7 | 8 | (* from ocaml/myocamlbuild.ml *) 9 | copy_rule "Temporary rule, waiting for a full usage of ocamlbuild" "%.mlbuild" "%.ml";; 10 | 11 | (* The numeric opcodes *) 12 | rule "The numeric opcodes" 13 | ~prod:"ocaml/bytecomp/opcodes.ml" 14 | ~dep:"ocaml/byterun/instruct.h" 15 | ~insert:`top 16 | begin fun _ _ -> 17 | Cmd(Sh "sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' ocaml/byterun/instruct.h | \ 18 | awk -f ../ocaml/tools/make-opcodes > ocaml/bytecomp/opcodes.ml") 19 | end;; 20 | 21 | rule "ocaml/bytecomp/runtimedef.ml" 22 | ~prod:"ocaml/bytecomp/runtimedef.ml" 23 | ~deps:["ocaml/byterun/primitives"; "ocaml/byterun/fail.h"] 24 | begin fun _ _ -> 25 | Cmd(S[A"../../../build/mkruntimedef.sh";Sh">"; Px"ocaml/bytecomp/runtimedef.ml"]) 26 | end;; 27 | -------------------------------------------------------------------------------- /src/jscomp/ocamljs_config.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This program is free software released under the QPL. 7 | * See LICENSE for more details. 8 | * 9 | * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 10 | * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 11 | * FITNESS FOR A PARTICULAR PURPOSE. 12 | *) 13 | 14 | let jsversion = "0.3" 15 | 16 | let cmjs_magic_number = "Caml1999J006" 17 | let cmjsa_magic_number = "Caml1999H007" 18 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.0/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.0/translclass.ml.patch: -------------------------------------------------------------------------------- 1 | --- translclass.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translclass.ml 2010-08-19 15:45:52.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -26,6 +39,14 @@ 21 | 22 | exception Error of Location.t * error 23 | 24 | +let lfunction' params body = 25 | + (* the params = [] case is used only in the call to builtin_meths *) 26 | + match body with 27 | + Lfunction (Curried, params', body') -> 28 | + Lfunction (Curried, params @ params', body') 29 | + | _ -> 30 | + Lfunction (Curried, params, body) 31 | + 32 | let lfunction params body = 33 | if params = [] then body else 34 | match body with 35 | @@ -640,11 +661,21 @@ 36 | if not arr || !Clflags.debug then raise Not_found; 37 | builtin_meths [self] env env2 (lfunction args body') 38 | with Not_found -> 39 | - [lfunction (self :: args) 40 | - (if not (IdentSet.mem env (free_variables body')) then body' else 41 | - Llet(Alias, env, 42 | - Lprim(Parrayrefu Paddrarray, 43 | - [Lvar self; Lvar env2]), body'))] 44 | + let this = 45 | + let desc = { 46 | + Primitive.prim_name = "$this"; 47 | + prim_arity = 0; 48 | + prim_alloc = false; 49 | + prim_native_name = ""; 50 | + prim_native_float = false; 51 | + } in 52 | + Lprim (Pccall desc, []) in 53 | + [lfunction' args 54 | + (Llet(Strict, self, this, 55 | + (if not (IdentSet.mem env (free_variables body')) then body' else 56 | + Llet(Alias, env, 57 | + Lprim(Parrayrefu Paddrarray, 58 | + [Lvar self; Lvar env2]), body'))))] 59 | end 60 | | _ -> assert false 61 | in 62 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.0/translcore.ml.patch: -------------------------------------------------------------------------------- 1 | --- translcore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translcore.ml 2010-08-19 15:45:47.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -654,6 +667,22 @@ 21 | end 22 | | Texp_construct(cstr, args) -> 23 | let ll = transl_list args in 24 | + if has_base_type e Predef.path_bool 25 | + then 26 | + let desc = { 27 | + prim_name = 28 | + begin match cstr.cstr_tag with 29 | + | Cstr_constant 0 -> "$false" 30 | + | Cstr_constant 1 -> "$true" 31 | + | _ -> assert false 32 | + end; 33 | + prim_arity = 0; 34 | + prim_alloc = false; 35 | + prim_native_name = ""; 36 | + prim_native_float = false; 37 | + } in 38 | + Lprim (Pccall desc, []) 39 | + else 40 | begin match cstr.cstr_tag with 41 | Cstr_constant n -> 42 | Lconst(Const_pointer n) 43 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.0/translobj.ml.patch: -------------------------------------------------------------------------------- 1 | --- translobj.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translobj.ml 2010-08-19 15:45:45.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -64,22 +77,7 @@ 21 | is_path lam1 && is_path lam2 22 | | _ -> false 23 | 24 | -let meth obj lab = 25 | - let tag = meth_tag lab in 26 | - if not (!cache_required && !Clflags.native_code) then (tag, []) else 27 | - if not (is_path obj) then next_cache tag else 28 | - try 29 | - let r = List.assoc obj !method_table in 30 | - try 31 | - (tag, List.assoc tag !r) 32 | - with Not_found -> 33 | - let p = next_cache tag in 34 | - r := p :: !r; 35 | - p 36 | - with Not_found -> 37 | - let p = next_cache tag in 38 | - method_table := (obj, ref [p]) :: !method_table; 39 | - p 40 | +let meth obj lab = (Lconst(Const_immstring lab), []) 41 | 42 | let reset_labels () = 43 | Hashtbl.clear consts; 44 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.0/typecore.ml.patch: -------------------------------------------------------------------------------- 1 | --- typecore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ typecore.ml 2010-08-19 15:45:44.000000000 -0400 3 | @@ -1,3 +1,15 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2010 Jake Donham 7 | + * 8 | + * This program is free software released under the QPL. 9 | + * See LICENSE for more details. 10 | + * 11 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | + * FITNESS FOR A PARTICULAR PURPOSE. 14 | + *) 15 | + 16 | (***********************************************************************) 17 | (* *) 18 | (* Objective Caml *) 19 | @@ -1353,17 +1365,21 @@ 20 | let (obj_ty, res_ty) = filter_arrow env method_type "" in 21 | unify env obj_ty desc.val_type; 22 | unify env res_ty (instance typ); 23 | - (Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id, 24 | - {val_type = method_type; 25 | - val_kind = Val_reg}); 26 | - exp_loc = sexp.pexp_loc; 27 | - exp_type = method_type; 28 | - exp_env = env }, 29 | - [Some {exp_desc = Texp_ident(path, desc); 30 | - exp_loc = obj.exp_loc; 31 | - exp_type = desc.val_type; 32 | - exp_env = env }, 33 | - Required]), 34 | + (* 35 | + method_id here is an function, not a slot as in 36 | + the self case. we mark it (through a gross hack) 37 | + so we can do the right thing in jsgen.ml 38 | + *) 39 | + let flags_field = 2 in (* see ident.ml *) 40 | + let repr = Obj.repr method_id in 41 | + let flags = (Obj.obj (Obj.field repr flags_field) : int) in 42 | + let flags = flags lor 4 in (* unused bit we will check in jsgen.ml *) 43 | + Obj.set_field repr flags_field (Obj.repr flags); 44 | + (Texp_send({exp_desc = Texp_ident(path, desc); 45 | + exp_loc = obj.exp_loc; 46 | + exp_type = desc.val_type; 47 | + exp_env = env }, 48 | + Tmeth_val method_id), 49 | typ) 50 | | _ -> 51 | assert false 52 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.1/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.1/translclass.ml.patch: -------------------------------------------------------------------------------- 1 | --- translclass.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translclass.ml 2010-08-19 15:45:25.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -26,6 +39,14 @@ 21 | 22 | exception Error of Location.t * error 23 | 24 | +let lfunction' params body = 25 | + (* the params = [] case is used only in the call to builtin_meths *) 26 | + match body with 27 | + Lfunction (Curried, params', body') -> 28 | + Lfunction (Curried, params @ params', body') 29 | + | _ -> 30 | + Lfunction (Curried, params, body) 31 | + 32 | let lfunction params body = 33 | if params = [] then body else 34 | match body with 35 | @@ -640,11 +661,21 @@ 36 | if not arr || !Clflags.debug then raise Not_found; 37 | builtin_meths [self] env env2 (lfunction args body') 38 | with Not_found -> 39 | - [lfunction (self :: args) 40 | - (if not (IdentSet.mem env (free_variables body')) then body' else 41 | - Llet(Alias, env, 42 | - Lprim(Parrayrefu Paddrarray, 43 | - [Lvar self; Lvar env2]), body'))] 44 | + let this = 45 | + let desc = { 46 | + Primitive.prim_name = "$this"; 47 | + prim_arity = 0; 48 | + prim_alloc = false; 49 | + prim_native_name = ""; 50 | + prim_native_float = false; 51 | + } in 52 | + Lprim (Pccall desc, []) in 53 | + [lfunction' args 54 | + (Llet(Strict, self, this, 55 | + (if not (IdentSet.mem env (free_variables body')) then body' else 56 | + Llet(Alias, env, 57 | + Lprim(Parrayrefu Paddrarray, 58 | + [Lvar self; Lvar env2]), body'))))] 59 | end 60 | | _ -> assert false 61 | in 62 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.1/translcore.ml.patch: -------------------------------------------------------------------------------- 1 | --- translcore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translcore.ml 2010-08-19 15:45:19.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -654,6 +667,22 @@ 21 | end 22 | | Texp_construct(cstr, args) -> 23 | let ll = transl_list args in 24 | + if has_base_type e Predef.path_bool 25 | + then 26 | + let desc = { 27 | + prim_name = 28 | + begin match cstr.cstr_tag with 29 | + | Cstr_constant 0 -> "$false" 30 | + | Cstr_constant 1 -> "$true" 31 | + | _ -> assert false 32 | + end; 33 | + prim_arity = 0; 34 | + prim_alloc = false; 35 | + prim_native_name = ""; 36 | + prim_native_float = false; 37 | + } in 38 | + Lprim (Pccall desc, []) 39 | + else 40 | begin match cstr.cstr_tag with 41 | Cstr_constant n -> 42 | Lconst(Const_pointer n) 43 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.1/translobj.ml.patch: -------------------------------------------------------------------------------- 1 | --- translobj.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translobj.ml 2010-08-19 15:45:18.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -64,22 +77,7 @@ 21 | is_path lam1 && is_path lam2 22 | | _ -> false 23 | 24 | -let meth obj lab = 25 | - let tag = meth_tag lab in 26 | - if not (!cache_required && !Clflags.native_code) then (tag, []) else 27 | - if not (is_path obj) then next_cache tag else 28 | - try 29 | - let r = List.assoc obj !method_table in 30 | - try 31 | - (tag, List.assoc tag !r) 32 | - with Not_found -> 33 | - let p = next_cache tag in 34 | - r := p :: !r; 35 | - p 36 | - with Not_found -> 37 | - let p = next_cache tag in 38 | - method_table := (obj, ref [p]) :: !method_table; 39 | - p 40 | +let meth obj lab = (Lconst(Const_immstring lab), []) 41 | 42 | let reset_labels () = 43 | Hashtbl.clear consts; 44 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.1/typecore.ml.patch: -------------------------------------------------------------------------------- 1 | --- typecore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ typecore.ml 2010-08-19 15:45:15.000000000 -0400 3 | @@ -1,3 +1,15 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2010 Jake Donham 7 | + * 8 | + * This program is free software released under the QPL. 9 | + * See LICENSE for more details. 10 | + * 11 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | + * FITNESS FOR A PARTICULAR PURPOSE. 14 | + *) 15 | + 16 | (***********************************************************************) 17 | (* *) 18 | (* Objective Caml *) 19 | @@ -1355,17 +1367,21 @@ 20 | let (obj_ty, res_ty) = filter_arrow env method_type "" in 21 | unify env obj_ty desc.val_type; 22 | unify env res_ty (instance typ); 23 | - (Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id, 24 | - {val_type = method_type; 25 | - val_kind = Val_reg}); 26 | - exp_loc = sexp.pexp_loc; 27 | - exp_type = method_type; 28 | - exp_env = env }, 29 | - [Some {exp_desc = Texp_ident(path, desc); 30 | - exp_loc = obj.exp_loc; 31 | - exp_type = desc.val_type; 32 | - exp_env = env }, 33 | - Required]), 34 | + (* 35 | + method_id here is an function, not a slot as in 36 | + the self case. we mark it (through a gross hack) 37 | + so we can do the right thing in jsgen.ml 38 | + *) 39 | + let flags_field = 2 in (* see ident.ml *) 40 | + let repr = Obj.repr method_id in 41 | + let flags = (Obj.obj (Obj.field repr flags_field) : int) in 42 | + let flags = flags lor 4 in (* unused bit we will check in jsgen.ml *) 43 | + Obj.set_field repr flags_field (Obj.repr flags); 44 | + (Texp_send({exp_desc = Texp_ident(path, desc); 45 | + exp_loc = obj.exp_loc; 46 | + exp_type = desc.val_type; 47 | + exp_env = env }, 48 | + Tmeth_val method_id), 49 | typ) 50 | | _ -> 51 | assert false 52 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.2/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.2/translclass.ml.patch: -------------------------------------------------------------------------------- 1 | --- translclass.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translclass.ml 2010-08-19 15:45:42.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -26,6 +39,14 @@ 21 | 22 | exception Error of Location.t * error 23 | 24 | +let lfunction' params body = 25 | + (* the params = [] case is used only in the call to builtin_meths *) 26 | + match body with 27 | + Lfunction (Curried, params', body') -> 28 | + Lfunction (Curried, params @ params', body') 29 | + | _ -> 30 | + Lfunction (Curried, params, body) 31 | + 32 | let lfunction params body = 33 | if params = [] then body else 34 | match body with 35 | @@ -640,11 +661,21 @@ 36 | if not arr || !Clflags.debug then raise Not_found; 37 | builtin_meths [self] env env2 (lfunction args body') 38 | with Not_found -> 39 | - [lfunction (self :: args) 40 | - (if not (IdentSet.mem env (free_variables body')) then body' else 41 | - Llet(Alias, env, 42 | - Lprim(Parrayrefu Paddrarray, 43 | - [Lvar self; Lvar env2]), body'))] 44 | + let this = 45 | + let desc = { 46 | + Primitive.prim_name = "$this"; 47 | + prim_arity = 0; 48 | + prim_alloc = false; 49 | + prim_native_name = ""; 50 | + prim_native_float = false; 51 | + } in 52 | + Lprim (Pccall desc, []) in 53 | + [lfunction' args 54 | + (Llet(Strict, self, this, 55 | + (if not (IdentSet.mem env (free_variables body')) then body' else 56 | + Llet(Alias, env, 57 | + Lprim(Parrayrefu Paddrarray, 58 | + [Lvar self; Lvar env2]), body'))))] 59 | end 60 | | _ -> assert false 61 | in 62 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.2/translcore.ml.patch: -------------------------------------------------------------------------------- 1 | --- translcore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translcore.ml 2010-08-19 15:45:33.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -654,6 +667,22 @@ 21 | end 22 | | Texp_construct(cstr, args) -> 23 | let ll = transl_list args in 24 | + if has_base_type e Predef.path_bool 25 | + then 26 | + let desc = { 27 | + prim_name = 28 | + begin match cstr.cstr_tag with 29 | + | Cstr_constant 0 -> "$false" 30 | + | Cstr_constant 1 -> "$true" 31 | + | _ -> assert false 32 | + end; 33 | + prim_arity = 0; 34 | + prim_alloc = false; 35 | + prim_native_name = ""; 36 | + prim_native_float = false; 37 | + } in 38 | + Lprim (Pccall desc, []) 39 | + else 40 | begin match cstr.cstr_tag with 41 | Cstr_constant n -> 42 | Lconst(Const_pointer n) 43 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.2/translobj.ml.patch: -------------------------------------------------------------------------------- 1 | --- translobj.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translobj.ml 2010-08-19 15:45:30.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -64,22 +77,7 @@ 21 | is_path lam1 && is_path lam2 22 | | _ -> false 23 | 24 | -let meth obj lab = 25 | - let tag = meth_tag lab in 26 | - if not (!cache_required && !Clflags.native_code) then (tag, []) else 27 | - if not (is_path obj) then next_cache tag else 28 | - try 29 | - let r = List.assoc obj !method_table in 30 | - try 31 | - (tag, List.assoc tag !r) 32 | - with Not_found -> 33 | - let p = next_cache tag in 34 | - r := p :: !r; 35 | - p 36 | - with Not_found -> 37 | - let p = next_cache tag in 38 | - method_table := (obj, ref [p]) :: !method_table; 39 | - p 40 | +let meth obj lab = (Lconst(Const_immstring lab), []) 41 | 42 | let reset_labels () = 43 | Hashtbl.clear consts; 44 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.11.2/typecore.ml.patch: -------------------------------------------------------------------------------- 1 | --- typecore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ typecore.ml 2010-08-19 15:45:28.000000000 -0400 3 | @@ -1,3 +1,15 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2010 Jake Donham 7 | + * 8 | + * This program is free software released under the QPL. 9 | + * See LICENSE for more details. 10 | + * 11 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | + * FITNESS FOR A PARTICULAR PURPOSE. 14 | + *) 15 | + 16 | (***********************************************************************) 17 | (* *) 18 | (* Objective Caml *) 19 | @@ -1355,17 +1367,21 @@ 20 | let (obj_ty, res_ty) = filter_arrow env method_type "" in 21 | unify env obj_ty desc.val_type; 22 | unify env res_ty (instance typ); 23 | - (Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id, 24 | - {val_type = method_type; 25 | - val_kind = Val_reg}); 26 | - exp_loc = sexp.pexp_loc; 27 | - exp_type = method_type; 28 | - exp_env = env }, 29 | - [Some {exp_desc = Texp_ident(path, desc); 30 | - exp_loc = obj.exp_loc; 31 | - exp_type = desc.val_type; 32 | - exp_env = env }, 33 | - Required]), 34 | + (* 35 | + method_id here is an function, not a slot as in 36 | + the self case. we mark it (through a gross hack) 37 | + so we can do the right thing in jsgen.ml 38 | + *) 39 | + let flags_field = 2 in (* see ident.ml *) 40 | + let repr = Obj.repr method_id in 41 | + let flags = (Obj.obj (Obj.field repr flags_field) : int) in 42 | + let flags = flags lor 4 in (* unused bit we will check in jsgen.ml *) 43 | + Obj.set_field repr flags_field (Obj.repr flags); 44 | + (Texp_send({exp_desc = Texp_ident(path, desc); 45 | + exp_loc = obj.exp_loc; 46 | + exp_type = desc.val_type; 47 | + exp_env = env }, 48 | + Tmeth_val method_id), 49 | typ) 50 | | _ -> 51 | assert false 52 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.12.0/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.12.0/translclass.ml.patch: -------------------------------------------------------------------------------- 1 | --- translclass.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translclass.ml 2010-08-19 15:46:12.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -26,6 +39,14 @@ 21 | 22 | exception Error of Location.t * error 23 | 24 | +let lfunction' params body = 25 | + (* the params = [] case is used only in the call to builtin_meths *) 26 | + match body with 27 | + Lfunction (Curried, params', body') -> 28 | + Lfunction (Curried, params @ params', body') 29 | + | _ -> 30 | + Lfunction (Curried, params, body) 31 | + 32 | let lfunction params body = 33 | if params = [] then body else 34 | match body with 35 | @@ -640,11 +661,21 @@ 36 | if not arr || !Clflags.debug then raise Not_found; 37 | builtin_meths [self] env env2 (lfunction args body') 38 | with Not_found -> 39 | - [lfunction (self :: args) 40 | - (if not (IdentSet.mem env (free_variables body')) then body' else 41 | - Llet(Alias, env, 42 | - Lprim(Parrayrefu Paddrarray, 43 | - [Lvar self; Lvar env2]), body'))] 44 | + let this = 45 | + let desc = { 46 | + Primitive.prim_name = "$this"; 47 | + prim_arity = 0; 48 | + prim_alloc = false; 49 | + prim_native_name = ""; 50 | + prim_native_float = false; 51 | + } in 52 | + Lprim (Pccall desc, []) in 53 | + [lfunction' args 54 | + (Llet(Strict, self, this, 55 | + (if not (IdentSet.mem env (free_variables body')) then body' else 56 | + Llet(Alias, env, 57 | + Lprim(Parrayrefu Paddrarray, 58 | + [Lvar self; Lvar env2]), body'))))] 59 | end 60 | | _ -> assert false 61 | in 62 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.12.0/translcore.ml.patch: -------------------------------------------------------------------------------- 1 | --- translcore.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translcore.ml 2010-08-19 15:46:04.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -654,6 +667,22 @@ 21 | end 22 | | Texp_construct(cstr, args) -> 23 | let ll = transl_list args in 24 | + if has_base_type e Predef.path_bool 25 | + then 26 | + let desc = { 27 | + prim_name = 28 | + begin match cstr.cstr_tag with 29 | + | Cstr_constant 0 -> "$false" 30 | + | Cstr_constant 1 -> "$true" 31 | + | _ -> assert false 32 | + end; 33 | + prim_arity = 0; 34 | + prim_alloc = false; 35 | + prim_native_name = ""; 36 | + prim_native_float = false; 37 | + } in 38 | + Lprim (Pccall desc, []) 39 | + else 40 | begin match cstr.cstr_tag with 41 | Cstr_constant n -> 42 | Lconst(Const_pointer n) 43 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.12.0/translobj.ml.patch: -------------------------------------------------------------------------------- 1 | --- translobj.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ translobj.ml 2010-08-19 15:45:59.000000000 -0400 3 | @@ -1,3 +1,16 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This program is free software released under the QPL. 10 | + * See LICENSE for more details. 11 | + * 12 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 13 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 14 | + * FITNESS FOR A PARTICULAR PURPOSE. 15 | + *) 16 | + 17 | (***********************************************************************) 18 | (* *) 19 | (* Objective Caml *) 20 | @@ -64,22 +77,7 @@ 21 | is_path lam1 && is_path lam2 22 | | _ -> false 23 | 24 | -let meth obj lab = 25 | - let tag = meth_tag lab in 26 | - if not (!cache_required && !Clflags.native_code) then (tag, []) else 27 | - if not (is_path obj) then next_cache tag else 28 | - try 29 | - let r = List.assoc obj !method_table in 30 | - try 31 | - (tag, List.assoc tag !r) 32 | - with Not_found -> 33 | - let p = next_cache tag in 34 | - r := p :: !r; 35 | - p 36 | - with Not_found -> 37 | - let p = next_cache tag in 38 | - method_table := (obj, ref [p]) :: !method_table; 39 | - p 40 | +let meth obj lab = (Lconst(Const_immstring lab), []) 41 | 42 | let reset_labels () = 43 | Hashtbl.clear consts; 44 | -------------------------------------------------------------------------------- /src/jscomp/patches/3.12.0/typecore.ml.patch: -------------------------------------------------------------------------------- 1 | --- typecore.ml.orig 2010-08-19 16:00:58.000000000 -0400 2 | +++ typecore.ml 2010-08-19 16:01:25.000000000 -0400 3 | @@ -1,3 +1,15 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2010 Jake Donham 7 | + * 8 | + * This program is free software released under the QPL. 9 | + * See LICENSE for more details. 10 | + * 11 | + * The Software is provided AS IS with NO WARRANTY OF ANY KIND, 12 | + * INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY AND 13 | + * FITNESS FOR A PARTICULAR PURPOSE. 14 | + *) 15 | + 16 | (***********************************************************************) 17 | (* *) 18 | (* Objective Caml *) 19 | @@ -1414,17 +1402,21 @@ 20 | let (obj_ty, res_ty) = filter_arrow env method_type "" in 21 | unify env obj_ty desc.val_type; 22 | unify env res_ty (instance typ); 23 | - (Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id, 24 | - {val_type = method_type; 25 | - val_kind = Val_reg}); 26 | - exp_loc = loc; 27 | - exp_type = method_type; 28 | - exp_env = env }, 29 | - [Some {exp_desc = Texp_ident(path, desc); 30 | - exp_loc = obj.exp_loc; 31 | - exp_type = desc.val_type; 32 | - exp_env = env }, 33 | - Required]), 34 | + (* 35 | + method_id here is an function, not a slot as in 36 | + the self case. we mark it (through a gross hack) 37 | + so we can do the right thing in jsgen.ml 38 | + *) 39 | + let flags_field = 2 in (* see ident.ml *) 40 | + let repr = Obj.repr method_id in 41 | + let flags = (Obj.obj (Obj.field repr flags_field) : int) in 42 | + let flags = flags lor 4 in (* unused bit we will check in jsgen.ml *) 43 | + Obj.set_field repr flags_field (Obj.repr flags); 44 | + (Texp_send({exp_desc = Texp_ident(path, desc); 45 | + exp_loc = obj.exp_loc; 46 | + exp_type = desc.val_type; 47 | + exp_env = env }, 48 | + Tmeth_val method_id), 49 | typ) 50 | | _ -> 51 | assert false 52 | -------------------------------------------------------------------------------- /src/jslib/META: -------------------------------------------------------------------------------- 1 | name = "jslib" 2 | version = "0.1" 3 | description = "Javascript parsing, prettyprinting, tools" 4 | requires = "dynlink,camlp4.lib,ulex" 5 | archive(byte) = "jslib.cma" 6 | archive(native) = "jslib.cmxa" 7 | 8 | package "quotations" ( 9 | description = "Syntax extension: Quotations to create AST nodes" 10 | requires = "jslib" 11 | requires(syntax,preprocessor) = "ulex" 12 | archive(syntax,preprocessor) = "ulexing.cma,jslib.cma,syntax_quotations.cmo" 13 | archive(syntax,toploop) = "ulexing.cma,jslib.cma,syntax_quotations.cmo" 14 | ) 15 | 16 | package "inline" ( 17 | description = "Syntax extension: quotations for inline Javascript" 18 | requires(syntax,preprocessor) = "ulex" 19 | archive(syntax,preprocessor) = "ulexing.cma,jslib.cma,syntax_inline.cmo" 20 | ) 21 | 22 | package "lambda" ( 23 | description = "Syntax extension: quotations to create lambda nodes" 24 | requires(syntax,preprocessor) = "ulex" 25 | archive(syntax,preprocessor) = "ulexing.cma,jslib.cma,syntax_lambda.cmo" 26 | ) 27 | -------------------------------------------------------------------------------- /src/jslib/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | FILES=\ 4 | jslib.cma jslib.cmxa jslib.a \ 5 | syntax_quotations.cmo \ 6 | syntax_inline.cmo \ 7 | syntax_lambda.cmo \ 8 | jslib_ast.mli jslib_ast.cmi \ 9 | jslib_parse.mli jslib_parse.cmi \ 10 | jslib_pp.mli jslib_pp.cmi \ 11 | 12 | BFILES=$(addprefix _build/,$(FILES)) 13 | 14 | all: myocamlbuild.ml 15 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 16 | OCAMLPATH=`pwd`/../../stage \ 17 | ocamlbuild jslib.cma jslib.cmxa syntax_quotations.cmo syntax_inline.cmo syntax_lambda.cmo 18 | ocamlfind remove -destdir ../../stage jslib 19 | ocamlfind install -destdir ../../stage jslib META $(BFILES) 20 | 21 | doc: 22 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 23 | OCAMLPATH=`pwd`/../../stage \ 24 | ocamlbuild -no-links doc.docdir/index.html 25 | 26 | install: 27 | ocamlfind install jslib META $(BFILES) 28 | 29 | uninstall: 30 | ocamlfind remove jslib 31 | 32 | clean: 33 | ocamlbuild -clean 34 | rm -f myocamlbuild.ml 35 | 36 | myocamlbuild.ml: 37 | ln -s ../../tools/myocamlbuild.ml . 38 | -------------------------------------------------------------------------------- /src/jslib/_tags: -------------------------------------------------------------------------------- 1 | : syntax_camlp4o,pkg_camlp4,pkg_ulex 2 | : syntax_camlp4o,pkg_camlp4,pkg_camlp4.extend 3 | : pkg_ulex 4 | : syntax_camlp4o,pkg_camlp4.macro,pkg_camlp4.quotations.r 5 | : syntax_camlp4o,pkg_camlp4,pkg_camlp4.quotations,pkg_camlp4.foldgenerator,pkg_camlp4.metagenerator,lambda_meta_generator,pkg_camlp4.macro 6 | : syntax_camlp4o,pkg_camlp4,pkg_camlp4.quotations,pkg_camlp4.extend 7 | : syntax_camlp4o,pkg_camlp4,pkg_camlp4.quotations,pkg_camlp4.extend 8 | : syntax_camlp4o,pkg_camlp4,pkg_camlp4.quotations,pkg_camlp4.extend 9 | -------------------------------------------------------------------------------- /src/jslib/doc.odocl: -------------------------------------------------------------------------------- 1 | Jslib_ast 2 | Jslib_lexer 3 | Jslib_parse 4 | Jslib_pp 5 | -------------------------------------------------------------------------------- /src/jslib/jslib.mllib: -------------------------------------------------------------------------------- 1 | Jslib_lexer 2 | Jslib_ast 3 | Jslib_parse 4 | Jslib_pp 5 | -------------------------------------------------------------------------------- /src/jslib/jslib_ast.incl: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | type unop = 23 | | Jdelete 24 | | Jvoid 25 | | Jtypeof 26 | | Jadd2_pre 27 | | Jsub2_pre 28 | | Jadd_pre 29 | | Jsub_pre 30 | | Jtilde 31 | | Jnot 32 | | Jadd2_post 33 | | Jsub2_post 34 | 35 | and binop = 36 | | Jhashref 37 | | Jmul 38 | | Jdiv 39 | | Jmod 40 | | Jadd 41 | | Jsub 42 | | Jlt 43 | | Jgt 44 | | Jleq 45 | | Jgeq 46 | | Jlsr 47 | | Jlsl 48 | | Jasr 49 | | Jeq 50 | | Jneq 51 | | Jinstanceof 52 | | Jseq 53 | | Jsneq 54 | | Jland 55 | | Jlor 56 | | Jand 57 | | Jxor 58 | | Jor 59 | | Jcomma 60 | | Jassign 61 | | Jmul_assign 62 | | Jdiv_assign 63 | | Jmod_assign 64 | | Jadd_assign 65 | | Jsub_assign 66 | | Jlsl_assign 67 | | Jlsr_assign 68 | | Jasr_assign 69 | | Jand_assign 70 | | Jxor_assign 71 | | Jor_assign 72 | 73 | and exp = 74 | | Jthis of loc 75 | | Jvar of loc * string 76 | | Jarray of loc * exp 77 | | Jobject of loc * (exp * exp) list 78 | | Jstring of loc * string * bool (* true if double-quoted *) 79 | | Jnum of loc * string 80 | | Jnull of loc 81 | | Jbool of loc * bool 82 | | Jregexp of loc * string * string 83 | | Jfun of loc * string option * string list * stmt 84 | | Jfieldref of loc * exp * string 85 | | Junop of loc * unop * exp 86 | | Jbinop of loc * binop * exp * exp 87 | | Jite of loc * exp * exp * exp 88 | | Jcall of loc * exp * exp 89 | | Jnew of loc * exp * exp option 90 | | Jexp_nil of loc 91 | | Jexp_cons of loc * exp * exp 92 | | Jexp_Ant of loc * string 93 | 94 | and stmt = 95 | | Jvars of loc * (string * exp option) list 96 | | Jfuns of loc * string * string list * stmt 97 | | Jreturn of loc * exp option 98 | | Jcontinue of loc * string option 99 | | Jbreak of loc * string option 100 | | Jswitch of loc * exp * (exp * stmt) list * stmt 101 | | Jites of loc * exp * stmt * stmt option 102 | | Jthrow of loc * exp 103 | | Jexps of loc * exp 104 | | Jtrycatch of loc * stmt * (string * stmt) option * stmt 105 | | Jfor of loc * (string * exp option) list * exp option * exp option * exp option * stmt 106 | | Jdowhile of loc * stmt * exp 107 | | Jwhile of loc * exp * stmt 108 | | Jblock of loc * stmt 109 | | Jwith of loc * exp * stmt 110 | | Jlabel of loc * string * stmt 111 | | Jstmt_nil of loc 112 | | Jstmt_cons of loc * stmt * stmt 113 | | Jstmt_Ant of loc * string 114 | -------------------------------------------------------------------------------- /src/jslib/jslib_lexer.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (* adapted from CDuce parser/ulexer.mli *) 23 | 24 | open Camlp4.Sig 25 | 26 | type token = 27 | | KEYWORD of string 28 | | IDENT of string 29 | | INT of string 30 | | FLOAT of string 31 | | HEX of string 32 | | STRING of string * bool 33 | | REGEXP of string 34 | | ANTIQUOT of string * string 35 | | EOI 36 | 37 | module Loc : Loc with type t = Camlp4.PreCast.Loc.t 38 | module Token : Token with module Loc = Loc and type t = token 39 | module Error : Error 40 | 41 | val mk : unit -> (Loc.t -> char Stream.t -> (Token.t * Loc.t) Stream.t) 42 | -------------------------------------------------------------------------------- /src/jslib/jslib_parse.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | module Gram : Camlp4.Sig.Grammar.Static 23 | with module Loc = Jslib_lexer.Loc 24 | and module Token = Jslib_lexer.Token 25 | 26 | val statementList : Jslib_ast.stmt Gram.Entry.t 27 | val expression : Jslib_ast.exp Gram.Entry.t 28 | val parse_file : string -> Jslib_ast.stmt 29 | val parse_stdin : unit -> Jslib_ast.stmt 30 | val parse_string : string -> Jslib_ast.stmt 31 | 32 | val non_exp_antiquots : bool ref 33 | -------------------------------------------------------------------------------- /src/jslib/jslib_pp.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | val exp : Format.formatter -> Jslib_ast.exp -> unit 23 | val stmt : Format.formatter -> Jslib_ast.stmt -> unit 24 | 25 | val escaped : string -> string 26 | -------------------------------------------------------------------------------- /src/lwt-dom/META: -------------------------------------------------------------------------------- 1 | name="Lwt-DOM" 2 | description="Lwt support for DOM stuff" 3 | version="0.3" 4 | requires="lwt dom" 5 | archive(js)="lwt_dom.cmjs" 6 | -------------------------------------------------------------------------------- /src/lwt-dom/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 5 | OCAMLPATH=`pwd`/../../stage \ 6 | ocamlbuild lwt_dom.cmjs 7 | ocamlfind remove -destdir ../../stage lwt-dom 8 | ocamlfind install -destdir ../../stage lwt-dom META _build/*.cmi _build/*.cmjs 9 | 10 | doc: 11 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 12 | OCAMLPATH=`pwd`/../../stage \ 13 | ocamlbuild -no-links doc.docdir/index.html 14 | 15 | install: 16 | ocamlfind install lwt-dom META _build/*.cmi _build/*.cmjs 17 | 18 | uninstall: 19 | ocamlfind remove lwt-dom 20 | 21 | clean: 22 | ocamlbuild -clean 23 | rm -f myocamlbuild.ml 24 | 25 | myocamlbuild.ml: 26 | ln -s ../../tools/myocamlbuild.ml 27 | -------------------------------------------------------------------------------- /src/lwt-dom/_tags: -------------------------------------------------------------------------------- 1 | <*> : pkg_lwt,pkg_dom,pkg_ocamljs 2 | -------------------------------------------------------------------------------- /src/lwt-dom/doc.odocl: -------------------------------------------------------------------------------- 1 | Lwt_dom 2 | -------------------------------------------------------------------------------- /src/lwt-dom/lwt_dom.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2009 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | let sleep ms = 23 | let t, u = Lwt.task () in 24 | let timeout () = Lwt.wakeup u () in 25 | let id = Dom.window#setTimeout timeout (ms *. 1000.) in 26 | Lwt.on_cancel t (fun () -> Dom.window#clearTimeout id); 27 | t 28 | 29 | let yield () = sleep 0. 30 | 31 | let http_request ?(headers=[]) meth url = 32 | let t, u = Lwt.task () in 33 | let meth, body = 34 | match meth with 35 | | `Get -> "GET", None 36 | | `Post body -> "POST", Some body in 37 | let r = Dom.new_XMLHttpRequest () in 38 | r#open_ meth url true; 39 | List.iter 40 | (fun (k, v) -> r#setRequestHeader k v) 41 | headers; 42 | let fired = ref false in 43 | let onreadystatechange () = 44 | if r#_get_readyState = 4 45 | then begin 46 | if not !fired then Lwt.wakeup u r; 47 | fired := true 48 | end in 49 | r#_set_onreadystatechange onreadystatechange; 50 | r#send (match body with Some body -> body | _ -> Ocamljs.null ()); 51 | Lwt.on_cancel t (fun () -> r#abort); 52 | t 53 | -------------------------------------------------------------------------------- /src/lwt-dom/lwt_dom.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2009 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | val sleep : float -> unit Lwt.t 23 | (** [sleep d] is a thread which remains suspended for [d] seconds 24 | (letting other threads run) and then terminates. *) 25 | val yield : unit -> unit Lwt.t 26 | (** [yield ()] is a thread which suspends itself (letting other 27 | threads run) and then resumes as soon as possible and 28 | terminates. *) 29 | 30 | val http_request : ?headers:(string * string) list -> [ `Get | `Post of string ] -> string -> Dom.xMLHttpRequest Lwt.t 31 | -------------------------------------------------------------------------------- /src/lwt/META.patch: -------------------------------------------------------------------------------- 1 | 5a6 2 | > archive(js) = "lwt.cmjsa" 3 | -------------------------------------------------------------------------------- /src/lwt/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | cp $(SRCDIR_LWT)/src/core/* . 5 | (cd $(SRCDIR_LWT); ocamlbuild META); cp $(SRCDIR_LWT)/_build/META . 6 | patch -b META < META.patch 7 | ocamlbuild lwt.cmjsa 8 | 9 | doc: 10 | 11 | install: 12 | dir=`ocamlfind -query -format "%d" lwt`; \ 13 | cp META _build/lwt.cmjsa $$dir 14 | 15 | uninstall: 16 | dir=`ocamlfind -query -format "%d" lwt`; \ 17 | rm -f $$dir/lwt.cmjsa; \ 18 | cp META.orig $$dir/META 19 | 20 | clean: 21 | ocamlbuild -clean 22 | rm -f myocamlbuild.ml *.mllib *.ml *.mli META META.orig 23 | 24 | myocamlbuild.ml: 25 | ln -s ../../tools/myocamlbuild.ml 26 | -------------------------------------------------------------------------------- /src/lwt/_tags: -------------------------------------------------------------------------------- 1 | <*> : syntax_camlp4o,pkg_lwt.syntax 2 | -------------------------------------------------------------------------------- /src/mozilla/META: -------------------------------------------------------------------------------- 1 | name="Mozilla" 2 | description="Mozilla API bindings" 3 | version="0.3" 4 | archive(js) = "mozilla.cmjs" 5 | -------------------------------------------------------------------------------- /src/mozilla/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 5 | OCAMLPATH=`pwd`/../../stage \ 6 | ocamlbuild mozilla.cmjs 7 | 8 | doc: 9 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 10 | OCAMLPATH=`pwd`/../../stage \ 11 | ocamlbuild -no-links doc.docdir/index.html 12 | 13 | install: 14 | ocamlfind install mozilla META _build/*.cmi _build/*.cmjs 15 | 16 | uninstall: 17 | ocamlfind remove mozilla 18 | 19 | clean: 20 | ocamlbuild -clean 21 | rm -f myocamlbuild.ml 22 | 23 | myocamlbuild.ml: 24 | ln -s ../../tools/myocamlbuild.ml 25 | -------------------------------------------------------------------------------- /src/mozilla/_tags: -------------------------------------------------------------------------------- 1 | : pkg_ocamljs 2 | -------------------------------------------------------------------------------- /src/mozilla/doc.odocl: -------------------------------------------------------------------------------- 1 | Mozilla 2 | -------------------------------------------------------------------------------- /src/ocamljs/META: -------------------------------------------------------------------------------- 1 | name="Ocamljs" 2 | description="Ocamljs support" 3 | version="0.3" 4 | archive(js) = "ocamljs.cmjs" 5 | -------------------------------------------------------------------------------- /src/ocamljs/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 5 | OCAMLPATH=`pwd`/../../stage \ 6 | ocamlbuild ocamljs.cmjs 7 | ocamlfind remove -destdir ../../stage ocamljs 8 | ocamlfind install -destdir ../../stage ocamljs META _build/*.cmi _build/*.cmjs 9 | 10 | doc: 11 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 12 | OCAMLPATH=`pwd`/../../stage \ 13 | ocamlbuild -no-links doc.docdir/index.html 14 | 15 | install: 16 | ocamlfind install ocamljs META _build/*.cmi _build/*.cmjs 17 | 18 | uninstall: 19 | ocamlfind remove ocamljs 20 | 21 | clean: 22 | ocamlbuild -clean 23 | rm -f myocamlbuild.ml 24 | 25 | myocamlbuild.ml: 26 | ln -s ../../tools/myocamlbuild.ml 27 | -------------------------------------------------------------------------------- /src/ocamljs/_tags: -------------------------------------------------------------------------------- 1 | : syntax_camlp4o,pkg_camlp4.macro,pkg_jslib.inline 2 | -------------------------------------------------------------------------------- /src/ocamljs/doc.odocl: -------------------------------------------------------------------------------- 1 | Ocamljs 2 | -------------------------------------------------------------------------------- /src/ocamljs/ocamljs.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | external assign : 'a -> 'a -> unit = "$assign" 23 | (* external call : 'func -> 'arg1 -> ... -> 'return= "$call" *) 24 | external false_ : unit -> bool = "$false" 25 | external fieldref : 'a -> string -> 'b = "$fieldref" 26 | external function_ : 'a -> 'b = "$function" (* XXX better type? *) 27 | external hashref : 'a -> 'b -> 'c = "$hashref" 28 | (* external new_ : = 'arg1 -> ... -> 'class "$new" "class" *) 29 | external null : unit -> 'a = "$null" 30 | external obj : (string * 'a) list -> 'b = "$obj" 31 | external this : unit -> 'a = "$this" 32 | external throw : 'a -> 'b = "$throw" 33 | external true_ : unit -> bool = "$true" 34 | external var : string -> 'a = "$var" 35 | 36 | external caml_callback : ('a -> 'b) -> 'a -> 'b = "caml_callback" 37 | external caml_callback2 : ('a1 -> 'a2 -> 'b) -> 'a1 -> 'a2 -> 'b = "caml_callback2" 38 | external caml_callback3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'a1 -> 'a2 -> 'a3 -> 'b = "caml_callback3" 39 | external caml_callback4 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'b) -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'b = "caml_callback4" 40 | external caml_callback5 : ('a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b) -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b = "caml_callback5" 41 | 42 | (* XXX do these belong here? *) 43 | let option_of_nullable x = 44 | if x == null() 45 | then None 46 | else Some x 47 | 48 | let nullable_of_option x = 49 | match x with 50 | | None -> null() 51 | | Some x -> x 52 | 53 | let is_null a = a = null () 54 | 55 | (* for backward compatibility *) 56 | type 'a jsfun = 'a 57 | external jsfun : 'a -> 'a = "%identity" 58 | external jsfun2 : 'a -> 'a = "%identity" 59 | external jsfun3 : 'a -> 'a = "%identity" 60 | external jsfun4 : 'a -> 'a = "%identity" 61 | external jsfun5 : 'a -> 'a = "%identity" 62 | 63 | module Inline = 64 | struct 65 | module Jslib_ast = 66 | struct 67 | type loc = unit 68 | INCLUDE "../../jslib/jslib_ast.incl" 69 | end 70 | 71 | external inline_exp : Jslib_ast.exp -> 'a = "$inline_exp" 72 | external inline_stmt : Jslib_ast.stmt -> unit = "$inline_stmt" 73 | external inline_rstmt : Jslib_ast.stmt -> 'a = "$inline_rstmt" 74 | external inline_antiexp : 'a -> Jslib_ast.exp = "$inline_antiexp" 75 | 76 | let _loc = () 77 | end 78 | -------------------------------------------------------------------------------- /src/ocamljs/ocamljs.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | external assign : 'a -> 'a -> unit = "$assign" 23 | (* external call : 'func -> 'arg1 -> ... -> 'return= "$call" *) 24 | external false_ : unit -> bool = "$false" 25 | external fieldref : 'a -> string -> 'b = "$fieldref" 26 | external function_ : 'a -> 'b = "$function" (* XXX better type? *) 27 | external hashref : 'a -> 'b -> 'c = "$hashref" 28 | (* external new_ : = 'arg1 -> ... -> 'class "$new" "class" *) 29 | external null : unit -> 'a = "$null" 30 | external obj : (string * 'a) list -> 'b = "$obj" 31 | external this : unit -> 'a = "$this" 32 | external throw : 'a -> 'b = "$throw" 33 | external true_ : unit -> bool = "$true" 34 | external var : string -> 'a = "$var" 35 | 36 | external caml_callback : ('a -> 'b) -> 'a -> 'b = "caml_callback" 37 | external caml_callback2 : ('a1 -> 'a2 -> 'b) -> 'a1 -> 'a2 -> 'b = "caml_callback2" 38 | external caml_callback3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'a1 -> 'a2 -> 'a3 -> 'b = "caml_callback3" 39 | 40 | val option_of_nullable : 'a -> 'a option 41 | val nullable_of_option : 'a option -> 'a 42 | val is_null : 'a -> bool 43 | 44 | (* for backward compatibility *) 45 | type 'a jsfun = 'a 46 | external jsfun : 'a -> 'a = "%identity" 47 | external jsfun2 : 'a -> 'a = "%identity" 48 | external jsfun3 : 'a -> 'a = "%identity" 49 | external jsfun4 : 'a -> 'a = "%identity" 50 | external jsfun5 : 'a -> 'a = "%identity" 51 | 52 | module Inline : 53 | sig 54 | module Jslib_ast : 55 | sig 56 | type loc = unit 57 | INCLUDE "../../jslib/jslib_ast.incl" 58 | end 59 | 60 | external inline_exp : Jslib_ast.exp -> 'a = "$inline_exp" 61 | external inline_stmt : Jslib_ast.stmt -> unit = "$inline_stmt" 62 | external inline_rstmt : Jslib_ast.stmt -> 'a = "$inline_rstmt" 63 | external inline_antiexp : 'a -> Jslib_ast.exp = "$inline_antiexp" 64 | 65 | val _loc : Jslib_ast.loc 66 | end 67 | -------------------------------------------------------------------------------- /src/ounit/META.patch: -------------------------------------------------------------------------------- 1 | 4c4,7 2 | < requires = "unix" 3 | --- 4 | > requires(js) = "javascript" 5 | > requires(byte) = "unix" 6 | > requires(native) = "unix" 7 | > archive(js) = "oUnit.cmjsa" 8 | -------------------------------------------------------------------------------- /src/ounit/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | all: myocamlbuild.ml 4 | cp $(SRCDIR_OUNIT)/oUnit.ml . 5 | cp $(SRCDIR_OUNIT)/oUnit.mli . 6 | cp $(SRCDIR_OUNIT)/META . 7 | patch oUnit.ml < oUnit.ml.patch 8 | patch -b META < META.patch 9 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \ 10 | OCAMLPATH=`pwd`/../../stage \ 11 | ocamlbuild oUnit.cmjsa 12 | 13 | doc: 14 | 15 | install: 16 | dir=`ocamlfind -query -format "%d" oUnit`; \ 17 | cp META _build/oUnit.cmjsa $$dir 18 | 19 | uninstall: 20 | dir=`ocamlfind -query -format "%d" oUnit`; \ 21 | rm -f $$dir/oUnit.cmjsa; \ 22 | cp META.orig $$dir/META 23 | 24 | clean: 25 | ocamlbuild -clean 26 | rm -f myocamlbuild.ml *.ml *.mli META META.orig 27 | 28 | myocamlbuild.ml: 29 | ln -s ../../tools/myocamlbuild.ml 30 | -------------------------------------------------------------------------------- /src/ounit/README: -------------------------------------------------------------------------------- 1 | For OUnit to work, you need to run linked `.js` files through a 2 | SpiderMonkey patched with js.patch in this directory (or make the 3 | equivalent change to some other Javascript interpreter). 4 | -------------------------------------------------------------------------------- /src/ounit/_tags: -------------------------------------------------------------------------------- 1 | : pkg_javascript 2 | -------------------------------------------------------------------------------- /src/ounit/js.patch: -------------------------------------------------------------------------------- 1 | --- js-1.7.0/src/js.c 2007-04-20 14:45:18.000000000 -0400 2 | +++ js-1.7.0.patched/src/js.c 2010-01-13 21:33:25.000000000 -0500 3 | @@ -694,1 +694,1 @@ 4 | } 5 | 6 | static JSBool 7 | +Print_verbatim(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) 8 | +{ 9 | + uintN i, n; 10 | + JSString *str; 11 | + 12 | + for (i = n = 0; i < argc; i++) { 13 | + str = JS_ValueToString(cx, argv[i]); 14 | + if (!str) 15 | + return JS_FALSE; 16 | + fprintf(gOutFile, "%s", JS_GetStringBytes(str)); 17 | + } 18 | + fflush(gOutFile); 19 | + return JS_TRUE; 20 | +} 21 | + 22 | +static JSBool 23 | Help(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval); 24 | 25 | static JSBool 26 | @@ -2129,6 +2145,7 @@ 27 | {"load", Load, 1,0,0}, 28 | {"readline", ReadLine, 0,0,0}, 29 | {"print", Print, 0,0,0}, 30 | + {"print_verbatim", Print_verbatim, 0,0,0}, 31 | {"help", Help, 0,0,0}, 32 | {"quit", Quit, 0,0,0}, 33 | {"gc", GC, 0,0,0}, 34 | -------------------------------------------------------------------------------- /src/ounit/oUnit.ml.patch: -------------------------------------------------------------------------------- 1 | 322,323c322,325 2 | < let begin_time = Unix.gettimeofday () in 3 | < (Unix.gettimeofday () -. begin_time, f x y) 4 | --- 5 | > let gettimeofday () = (Javascript.new_Date())#getTime /. 1000. in 6 | > let begin_time = gettimeofday() in 7 | > let r = f x y in 8 | > gettimeofday() -. begin_time, r 9 | 381c383 10 | < printf "OK" 11 | --- 12 | > printf "OK\n" 13 | 399a402 14 | > (* 15 | 408a412 16 | > *) 17 | -------------------------------------------------------------------------------- /src/ounit/ounit.mllib: -------------------------------------------------------------------------------- 1 | OUnit 2 | -------------------------------------------------------------------------------- /src/stdlib/Makefile: -------------------------------------------------------------------------------- 1 | -include ../../Makefile.conf 2 | 3 | ML=buffer.ml printf.ml camlinternalMod.ml pervasives.ml camlinternalOO.ml 4 | MLI=$(addsuffix .mli,$(basename $(ML))) 5 | 6 | all: myocamlbuild.ml ocaml $(ML) $(MLI) random.mli stdlib.mllib 7 | OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR) \ 8 | OCAMLPATH=`pwd`/../../stage \ 9 | ocamlbuild stdlib.cmjsa std_exit.cmjs 10 | 11 | %.ml : patches/$(OCAML_VERSION)/%.ml.patch 12 | cp ocaml/stdlib/$@ . 13 | patch $@ $< 14 | 15 | %.mli : 16 | ln -s ocaml/stdlib/$@ . 17 | 18 | doc: 19 | 20 | install: 21 | cp _build/stdlib.cmjsa $(LIBDIR) 22 | cp _build/ocaml/stdlib/std_exit.cmjs $(LIBDIR) 23 | cp support.js primitives.js $(LIBDIR) 24 | 25 | uninstall: 26 | rm -f $(LIBDIR)/stdlib.cmjsa 27 | rm -f $(LIBDIR)/std_exit.cmjs 28 | rm -f $(LIBDIR)/support.js $(LIBDIR)/primitives.js 29 | 30 | clean: 31 | ocamlbuild -clean 32 | rm -f myocamlbuild.ml 33 | rm -f ocaml 34 | rm -f stdlib.mllib $(ML) $(MLI) random.mli 35 | 36 | myocamlbuild.ml: ../../tools/myocamlbuild.ml myocamlbuild.mlp 37 | cat ../../tools/myocamlbuild.ml myocamlbuild.mlp > myocamlbuild.ml 38 | 39 | ocaml: 40 | ln -s ../../ocaml . 41 | 42 | stdlib.mllib: 43 | ln -s ocaml/stdlib/stdlib.mllib . 44 | 45 | patches: 46 | for ver in $(VERSIONS); do \ 47 | $(MAKE) -C patches/$$ver patches || exit; \ 48 | done 49 | 50 | .PHONY: patches 51 | -------------------------------------------------------------------------------- /src/stdlib/_tags: -------------------------------------------------------------------------------- 1 | or : nopervasives,pkg_ocamljs 2 | or or : syntax_camlp4o,pkg_jslib.inline,pkg_ocamljs 3 | : support_js,primitives_js 4 | -------------------------------------------------------------------------------- /src/stdlib/myocamlbuild.mlp: -------------------------------------------------------------------------------- 1 | (* The version number *) 2 | rule "ocaml/stdlib/sys.ml" 3 | ~prod:"ocaml/stdlib/sys.ml" 4 | ~deps:["ocaml/stdlib/sys.mlp"; "ocaml/VERSION"] 5 | begin fun _ _ -> 6 | let version = with_input_file "ocaml/VERSION" input_line in 7 | Seq [rm_f "ocaml/stdlib/sys.ml"; 8 | Cmd (S[A"sed"; A"-e"; 9 | A(Printf.sprintf "s,%%%%VERSION%%%%,%s," version); 10 | Sh"<"; P"ocaml/stdlib/sys.mlp"; Sh">"; Px"ocaml/stdlib/sys.ml"]); 11 | chmod (A"-w") "ocaml/stdlib/sys.ml"] 12 | end;; 13 | 14 | Pathname.define_context "." ["."; "ocaml/stdlib"]; 15 | Pathname.define_context "ocaml/stdlib" ["."; "ocaml/stdlib"]; 16 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/buffer.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.0/buffer.ml -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/buffer.ml.orig: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.0/buffer.ml.orig -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/camlinternalMod.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (***********************************************************************) 23 | (* *) 24 | (* Objective Caml *) 25 | (* *) 26 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 27 | (* *) 28 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 29 | (* en Automatique. All rights reserved. This file is distributed *) 30 | (* under the terms of the GNU Library General Public License, with *) 31 | (* the special exception on linking described in file ../LICENSE. *) 32 | (* *) 33 | (***********************************************************************) 34 | 35 | (* $Id: camlinternalMod.ml,v 1.6 2008/01/11 16:13:16 doligez Exp $ *) 36 | 37 | type shape = 38 | | Function 39 | | Lazy 40 | | Class 41 | | Module of shape array 42 | 43 | let rec init_mod loc shape = 44 | match shape with 45 | | Function -> 46 | Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 47 | | Lazy -> 48 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 49 | | Class -> 50 | Obj.repr (CamlinternalOO.dummy_class loc) 51 | | Module comps -> 52 | Obj.repr (Array.map (init_mod loc) comps) 53 | 54 | let rec update_mod shape o n = 55 | match shape with 56 | | Module comps -> 57 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 58 | for i = 0 to Array.length comps - 1 do 59 | match comps.(i) with 60 | | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 61 | | _ -> Obj.set_field o i (Obj.field n i) 62 | done 63 | | _ -> assert false 64 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/camlinternalMod.ml.orig: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: camlinternalMod.ml,v 1.6 2008/01/11 16:13:16 doligez Exp $ *) 15 | 16 | type shape = 17 | | Function 18 | | Lazy 19 | | Class 20 | | Module of shape array 21 | 22 | let rec init_mod loc shape = 23 | match shape with 24 | | Function -> 25 | let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 26 | and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 27 | Obj.repr(fun _ -> 28 | ignore pad1; ignore pad2; ignore pad3; ignore pad4; 29 | ignore pad5; ignore pad6; ignore pad7; ignore pad8; 30 | raise (Undefined_recursive_module loc)) 31 | | Lazy -> 32 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 33 | | Class -> 34 | Obj.repr (CamlinternalOO.dummy_class loc) 35 | | Module comps -> 36 | Obj.repr (Array.map (init_mod loc) comps) 37 | 38 | let overwrite o n = 39 | assert (Obj.size o >= Obj.size n); 40 | for i = 0 to Obj.size n - 1 do 41 | Obj.set_field o i (Obj.field n i) 42 | done 43 | 44 | let rec update_mod shape o n = 45 | match shape with 46 | | Function -> 47 | if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 48 | then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 49 | else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 50 | | Lazy -> 51 | if Obj.tag n = Obj.lazy_tag then 52 | Obj.set_field o 0 (Obj.field n 0) 53 | else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 54 | Obj.set_tag o Obj.forward_tag; 55 | Obj.set_field o 0 (Obj.field n 0) 56 | end else begin 57 | (* forwarding pointer was shortcut by GC *) 58 | Obj.set_tag o Obj.forward_tag; 59 | Obj.set_field o 0 n 60 | end 61 | | Class -> 62 | assert (Obj.tag n = 0 && Obj.size n = 4); 63 | overwrite o n 64 | | Module comps -> 65 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 66 | for i = 0 to Array.length comps - 1 do 67 | update_mod comps.(i) (Obj.field o i) (Obj.field n i) 68 | done 69 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/camlinternalMod.ml.patch: -------------------------------------------------------------------------------- 1 | --- camlinternalMod.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ camlinternalMod.ml 2010-08-19 15:43:54.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -22,12 +43,7 @@ 29 | let rec init_mod loc shape = 30 | match shape with 31 | | Function -> 32 | - let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 33 | - and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 34 | - Obj.repr(fun _ -> 35 | - ignore pad1; ignore pad2; ignore pad3; ignore pad4; 36 | - ignore pad5; ignore pad6; ignore pad7; ignore pad8; 37 | - raise (Undefined_recursive_module loc)) 38 | + Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 39 | | Lazy -> 40 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 41 | | Class -> 42 | @@ -35,34 +51,13 @@ 43 | | Module comps -> 44 | Obj.repr (Array.map (init_mod loc) comps) 45 | 46 | -let overwrite o n = 47 | - assert (Obj.size o >= Obj.size n); 48 | - for i = 0 to Obj.size n - 1 do 49 | - Obj.set_field o i (Obj.field n i) 50 | - done 51 | - 52 | let rec update_mod shape o n = 53 | match shape with 54 | - | Function -> 55 | - if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 56 | - then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 57 | - else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 58 | - | Lazy -> 59 | - if Obj.tag n = Obj.lazy_tag then 60 | - Obj.set_field o 0 (Obj.field n 0) 61 | - else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 62 | - Obj.set_tag o Obj.forward_tag; 63 | - Obj.set_field o 0 (Obj.field n 0) 64 | - end else begin 65 | - (* forwarding pointer was shortcut by GC *) 66 | - Obj.set_tag o Obj.forward_tag; 67 | - Obj.set_field o 0 n 68 | - end 69 | - | Class -> 70 | - assert (Obj.tag n = 0 && Obj.size n = 4); 71 | - overwrite o n 72 | - | Module comps -> 73 | - assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 74 | - for i = 0 to Array.length comps - 1 do 75 | - update_mod comps.(i) (Obj.field o i) (Obj.field n i) 76 | - done 77 | + | Module comps -> 78 | + assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 79 | + for i = 0 to Array.length comps - 1 do 80 | + match comps.(i) with 81 | + | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 82 | + | _ -> Obj.set_field o i (Obj.field n i) 83 | + done 84 | + | _ -> assert false 85 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/pervasives.ml.patch: -------------------------------------------------------------------------------- 1 | --- pervasives.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ pervasives.ml 2010-08-19 15:43:56.000000000 -0400 3 | @@ -1,3 +1,26 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | +open Ocamljs.Inline 26 | + 27 | (***********************************************************************) 28 | (* *) 29 | (* Objective Caml *) 30 | @@ -137,11 +160,15 @@ 31 | = "caml_blit_string" "noalloc" 32 | 33 | let (^) s1 s2 = 34 | - let l1 = string_length s1 and l2 = string_length s2 in 35 | - let s = string_create (l1 + l2) in 36 | - string_blit s1 0 s 0 l1; 37 | - string_blit s2 0 s l1 l2; 38 | - s 39 | + (* camlp4 doesn't like (or) above, so we do this manually *) 40 | + inline_exp 41 | + (Jslib_ast.Jbinop (_loc, Jslib_ast.Jadd, 42 | + Jslib_ast.Jcall (_loc, 43 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s1, "toString"), 44 | + Jslib_ast.Jexp_nil _loc), 45 | + Jslib_ast.Jcall (_loc, 46 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s2, "toString"), 47 | + Jslib_ast.Jexp_nil _loc))) 48 | 49 | (* Character operations -- more in module Char *) 50 | 51 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.0/printf.ml.patch: -------------------------------------------------------------------------------- 1 | --- printf.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ printf.ml 2010-08-26 16:23:55.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -147,15 +168,6 @@ 29 | Buffer.contents b 30 | ;; 31 | 32 | -let extract_format_int conv fmt start stop widths = 33 | - let sfmt = extract_format fmt start stop widths in 34 | - match conv with 35 | - | 'n' | 'N' -> 36 | - sfmt.[String.length sfmt - 1] <- 'u'; 37 | - sfmt 38 | - | _ -> sfmt 39 | -;; 40 | - 41 | (* Returns the position of the next character following the meta format 42 | string, starting from position [i], inside a given format [fmt]. 43 | According to the character [conv], the meta format string is 44 | @@ -476,10 +488,10 @@ 45 | let s = 46 | if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in 47 | cont_s (next_index spec n) s (succ i) 48 | - | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv -> 49 | + | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' -> 50 | let (x : int) = get_arg spec n in 51 | let s = 52 | - format_int (extract_format_int conv fmt pos i widths) x in 53 | + format_int (extract_format fmt pos i widths) x in 54 | cont_s (next_index spec n) s (succ i) 55 | | 'f' | 'e' | 'E' | 'g' | 'G' -> 56 | let (x : float) = get_arg spec n in 57 | @@ -520,7 +532,7 @@ 58 | cont_s (next_index spec n) s (succ i) 59 | | _ -> 60 | let (x : int) = get_arg spec n in 61 | - let s = format_int (extract_format_int 'n' fmt pos i widths) x in 62 | + let s = format_int (extract_format fmt pos i widths) x in 63 | cont_s (next_index spec n) s (succ i) 64 | end 65 | | '!' -> cont_f n (succ i) 66 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/buffer.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.1/buffer.ml -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/buffer.ml.orig: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.1/buffer.ml.orig -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/camlinternalMod.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (***********************************************************************) 23 | (* *) 24 | (* Objective Caml *) 25 | (* *) 26 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 27 | (* *) 28 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 29 | (* en Automatique. All rights reserved. This file is distributed *) 30 | (* under the terms of the GNU Library General Public License, with *) 31 | (* the special exception on linking described in file ../LICENSE. *) 32 | (* *) 33 | (***********************************************************************) 34 | 35 | (* $Id: camlinternalMod.ml,v 1.6 2008/01/11 16:13:16 doligez Exp $ *) 36 | 37 | type shape = 38 | | Function 39 | | Lazy 40 | | Class 41 | | Module of shape array 42 | 43 | let rec init_mod loc shape = 44 | match shape with 45 | | Function -> 46 | Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 47 | | Lazy -> 48 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 49 | | Class -> 50 | Obj.repr (CamlinternalOO.dummy_class loc) 51 | | Module comps -> 52 | Obj.repr (Array.map (init_mod loc) comps) 53 | 54 | let rec update_mod shape o n = 55 | match shape with 56 | | Module comps -> 57 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 58 | for i = 0 to Array.length comps - 1 do 59 | match comps.(i) with 60 | | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 61 | | _ -> Obj.set_field o i (Obj.field n i) 62 | done 63 | | _ -> assert false 64 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/camlinternalMod.ml.orig: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: camlinternalMod.ml,v 1.6 2008/01/11 16:13:16 doligez Exp $ *) 15 | 16 | type shape = 17 | | Function 18 | | Lazy 19 | | Class 20 | | Module of shape array 21 | 22 | let rec init_mod loc shape = 23 | match shape with 24 | | Function -> 25 | let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 26 | and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 27 | Obj.repr(fun _ -> 28 | ignore pad1; ignore pad2; ignore pad3; ignore pad4; 29 | ignore pad5; ignore pad6; ignore pad7; ignore pad8; 30 | raise (Undefined_recursive_module loc)) 31 | | Lazy -> 32 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 33 | | Class -> 34 | Obj.repr (CamlinternalOO.dummy_class loc) 35 | | Module comps -> 36 | Obj.repr (Array.map (init_mod loc) comps) 37 | 38 | let overwrite o n = 39 | assert (Obj.size o >= Obj.size n); 40 | for i = 0 to Obj.size n - 1 do 41 | Obj.set_field o i (Obj.field n i) 42 | done 43 | 44 | let rec update_mod shape o n = 45 | match shape with 46 | | Function -> 47 | if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 48 | then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 49 | else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 50 | | Lazy -> 51 | if Obj.tag n = Obj.lazy_tag then 52 | Obj.set_field o 0 (Obj.field n 0) 53 | else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 54 | Obj.set_tag o Obj.forward_tag; 55 | Obj.set_field o 0 (Obj.field n 0) 56 | end else begin 57 | (* forwarding pointer was shortcut by GC *) 58 | Obj.set_tag o Obj.forward_tag; 59 | Obj.set_field o 0 n 60 | end 61 | | Class -> 62 | assert (Obj.tag n = 0 && Obj.size n = 4); 63 | overwrite o n 64 | | Module comps -> 65 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 66 | for i = 0 to Array.length comps - 1 do 67 | update_mod comps.(i) (Obj.field o i) (Obj.field n i) 68 | done 69 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/camlinternalMod.ml.patch: -------------------------------------------------------------------------------- 1 | --- camlinternalMod.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ camlinternalMod.ml 2010-08-19 15:43:08.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -22,12 +43,7 @@ 29 | let rec init_mod loc shape = 30 | match shape with 31 | | Function -> 32 | - let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 33 | - and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 34 | - Obj.repr(fun _ -> 35 | - ignore pad1; ignore pad2; ignore pad3; ignore pad4; 36 | - ignore pad5; ignore pad6; ignore pad7; ignore pad8; 37 | - raise (Undefined_recursive_module loc)) 38 | + Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 39 | | Lazy -> 40 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 41 | | Class -> 42 | @@ -35,34 +51,13 @@ 43 | | Module comps -> 44 | Obj.repr (Array.map (init_mod loc) comps) 45 | 46 | -let overwrite o n = 47 | - assert (Obj.size o >= Obj.size n); 48 | - for i = 0 to Obj.size n - 1 do 49 | - Obj.set_field o i (Obj.field n i) 50 | - done 51 | - 52 | let rec update_mod shape o n = 53 | match shape with 54 | - | Function -> 55 | - if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 56 | - then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 57 | - else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 58 | - | Lazy -> 59 | - if Obj.tag n = Obj.lazy_tag then 60 | - Obj.set_field o 0 (Obj.field n 0) 61 | - else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 62 | - Obj.set_tag o Obj.forward_tag; 63 | - Obj.set_field o 0 (Obj.field n 0) 64 | - end else begin 65 | - (* forwarding pointer was shortcut by GC *) 66 | - Obj.set_tag o Obj.forward_tag; 67 | - Obj.set_field o 0 n 68 | - end 69 | - | Class -> 70 | - assert (Obj.tag n = 0 && Obj.size n = 4); 71 | - overwrite o n 72 | - | Module comps -> 73 | - assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 74 | - for i = 0 to Array.length comps - 1 do 75 | - update_mod comps.(i) (Obj.field o i) (Obj.field n i) 76 | - done 77 | + | Module comps -> 78 | + assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 79 | + for i = 0 to Array.length comps - 1 do 80 | + match comps.(i) with 81 | + | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 82 | + | _ -> Obj.set_field o i (Obj.field n i) 83 | + done 84 | + | _ -> assert false 85 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/pervasives.ml.patch: -------------------------------------------------------------------------------- 1 | --- pervasives.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ pervasives.ml 2010-08-19 15:43:12.000000000 -0400 3 | @@ -1,3 +1,26 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | +open Ocamljs.Inline 26 | + 27 | (***********************************************************************) 28 | (* *) 29 | (* Objective Caml *) 30 | @@ -137,11 +160,15 @@ 31 | = "caml_blit_string" "noalloc" 32 | 33 | let (^) s1 s2 = 34 | - let l1 = string_length s1 and l2 = string_length s2 in 35 | - let s = string_create (l1 + l2) in 36 | - string_blit s1 0 s 0 l1; 37 | - string_blit s2 0 s l1 l2; 38 | - s 39 | + (* camlp4 doesn't like (or) above, so we do this manually *) 40 | + inline_exp 41 | + (Jslib_ast.Jbinop (_loc, Jslib_ast.Jadd, 42 | + Jslib_ast.Jcall (_loc, 43 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s1, "toString"), 44 | + Jslib_ast.Jexp_nil _loc), 45 | + Jslib_ast.Jcall (_loc, 46 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s2, "toString"), 47 | + Jslib_ast.Jexp_nil _loc))) 48 | 49 | (* Character operations -- more in module Char *) 50 | 51 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.1/printf.ml.patch: -------------------------------------------------------------------------------- 1 | --- printf.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ printf.ml 2010-08-26 16:25:58.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -148,24 +169,6 @@ 29 | Buffer.contents b 30 | ;; 31 | 32 | -let extract_format_int conv fmt start stop widths = 33 | - let sfmt = extract_format fmt start stop widths in 34 | - match conv with 35 | - | 'n' | 'N' -> 36 | - sfmt.[String.length sfmt - 1] <- 'u'; 37 | - sfmt 38 | - | _ -> sfmt 39 | -;; 40 | - 41 | -let extract_format_float conv fmt start stop widths = 42 | - let sfmt = extract_format fmt start stop widths in 43 | - match conv with 44 | - | 'F' -> 45 | - sfmt.[String.length sfmt - 1] <- 'f'; 46 | - sfmt 47 | - | _ -> sfmt 48 | -;; 49 | - 50 | (* Returns the position of the next character following the meta format 51 | string, starting from position [i], inside a given format [fmt]. 52 | According to the character [conv], the meta format string is 53 | @@ -511,19 +514,19 @@ 54 | let s = 55 | if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in 56 | cont_s (next_index spec n) s (succ i) 57 | - | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv -> 58 | + | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' -> 59 | let (x : int) = get_arg spec n in 60 | let s = 61 | - format_int (extract_format_int conv fmt pos i widths) x in 62 | + format_int (extract_format fmt pos i widths) x in 63 | cont_s (next_index spec n) s (succ i) 64 | | 'f' | 'e' | 'E' | 'g' | 'G' -> 65 | let (x : float) = get_arg spec n in 66 | let s = format_float (extract_format fmt pos i widths) x in 67 | cont_s (next_index spec n) s (succ i) 68 | - | 'F' as conv -> 69 | + | 'F' -> 70 | let (x : float) = get_arg spec n in 71 | let s = 72 | - format_float_lexem (extract_format_float conv fmt pos i widths) x in 73 | + format_float_lexem (extract_format fmt pos i widths) x in 74 | cont_s (next_index spec n) s (succ i) 75 | | 'B' | 'b' -> 76 | let (x : bool) = get_arg spec n in 77 | @@ -557,7 +560,7 @@ 78 | cont_s (next_index spec n) s (succ i) 79 | | _ -> 80 | let (x : int) = get_arg spec n in 81 | - let s = format_int (extract_format_int 'n' fmt pos i widths) x in 82 | + let s = format_int (extract_format fmt pos i widths) x in 83 | cont_s (next_index spec n) s (succ i) 84 | end 85 | | '!' -> cont_f n (succ i) 86 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/buffer.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.2/buffer.ml -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/buffer.ml.orig: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.11.2/buffer.ml.orig -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/camlinternalMod.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (***********************************************************************) 23 | (* *) 24 | (* Objective Caml *) 25 | (* *) 26 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 27 | (* *) 28 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 29 | (* en Automatique. All rights reserved. This file is distributed *) 30 | (* under the terms of the GNU Library General Public License, with *) 31 | (* the special exception on linking described in file ../LICENSE. *) 32 | (* *) 33 | (***********************************************************************) 34 | 35 | (* $Id: camlinternalMod.ml 8768 2008-01-11 16:13:18Z doligez $ *) 36 | 37 | type shape = 38 | | Function 39 | | Lazy 40 | | Class 41 | | Module of shape array 42 | 43 | let rec init_mod loc shape = 44 | match shape with 45 | | Function -> 46 | Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 47 | | Lazy -> 48 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 49 | | Class -> 50 | Obj.repr (CamlinternalOO.dummy_class loc) 51 | | Module comps -> 52 | Obj.repr (Array.map (init_mod loc) comps) 53 | 54 | let rec update_mod shape o n = 55 | match shape with 56 | | Module comps -> 57 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 58 | for i = 0 to Array.length comps - 1 do 59 | match comps.(i) with 60 | | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 61 | | _ -> Obj.set_field o i (Obj.field n i) 62 | done 63 | | _ -> assert false 64 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/camlinternalMod.ml.orig: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: camlinternalMod.ml 8768 2008-01-11 16:13:18Z doligez $ *) 15 | 16 | type shape = 17 | | Function 18 | | Lazy 19 | | Class 20 | | Module of shape array 21 | 22 | let rec init_mod loc shape = 23 | match shape with 24 | | Function -> 25 | let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 26 | and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 27 | Obj.repr(fun _ -> 28 | ignore pad1; ignore pad2; ignore pad3; ignore pad4; 29 | ignore pad5; ignore pad6; ignore pad7; ignore pad8; 30 | raise (Undefined_recursive_module loc)) 31 | | Lazy -> 32 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 33 | | Class -> 34 | Obj.repr (CamlinternalOO.dummy_class loc) 35 | | Module comps -> 36 | Obj.repr (Array.map (init_mod loc) comps) 37 | 38 | let overwrite o n = 39 | assert (Obj.size o >= Obj.size n); 40 | for i = 0 to Obj.size n - 1 do 41 | Obj.set_field o i (Obj.field n i) 42 | done 43 | 44 | let rec update_mod shape o n = 45 | match shape with 46 | | Function -> 47 | if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 48 | then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 49 | else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 50 | | Lazy -> 51 | if Obj.tag n = Obj.lazy_tag then 52 | Obj.set_field o 0 (Obj.field n 0) 53 | else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 54 | Obj.set_tag o Obj.forward_tag; 55 | Obj.set_field o 0 (Obj.field n 0) 56 | end else begin 57 | (* forwarding pointer was shortcut by GC *) 58 | Obj.set_tag o Obj.forward_tag; 59 | Obj.set_field o 0 n 60 | end 61 | | Class -> 62 | assert (Obj.tag n = 0 && Obj.size n = 4); 63 | overwrite o n 64 | | Module comps -> 65 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 66 | for i = 0 to Array.length comps - 1 do 67 | update_mod comps.(i) (Obj.field o i) (Obj.field n i) 68 | done 69 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/camlinternalMod.ml.patch: -------------------------------------------------------------------------------- 1 | --- camlinternalMod.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ camlinternalMod.ml 2010-08-19 15:43:33.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -22,12 +43,7 @@ 29 | let rec init_mod loc shape = 30 | match shape with 31 | | Function -> 32 | - let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 33 | - and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 34 | - Obj.repr(fun _ -> 35 | - ignore pad1; ignore pad2; ignore pad3; ignore pad4; 36 | - ignore pad5; ignore pad6; ignore pad7; ignore pad8; 37 | - raise (Undefined_recursive_module loc)) 38 | + Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 39 | | Lazy -> 40 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 41 | | Class -> 42 | @@ -35,34 +51,13 @@ 43 | | Module comps -> 44 | Obj.repr (Array.map (init_mod loc) comps) 45 | 46 | -let overwrite o n = 47 | - assert (Obj.size o >= Obj.size n); 48 | - for i = 0 to Obj.size n - 1 do 49 | - Obj.set_field o i (Obj.field n i) 50 | - done 51 | - 52 | let rec update_mod shape o n = 53 | match shape with 54 | - | Function -> 55 | - if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 56 | - then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 57 | - else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 58 | - | Lazy -> 59 | - if Obj.tag n = Obj.lazy_tag then 60 | - Obj.set_field o 0 (Obj.field n 0) 61 | - else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 62 | - Obj.set_tag o Obj.forward_tag; 63 | - Obj.set_field o 0 (Obj.field n 0) 64 | - end else begin 65 | - (* forwarding pointer was shortcut by GC *) 66 | - Obj.set_tag o Obj.forward_tag; 67 | - Obj.set_field o 0 n 68 | - end 69 | - | Class -> 70 | - assert (Obj.tag n = 0 && Obj.size n = 4); 71 | - overwrite o n 72 | - | Module comps -> 73 | - assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 74 | - for i = 0 to Array.length comps - 1 do 75 | - update_mod comps.(i) (Obj.field o i) (Obj.field n i) 76 | - done 77 | + | Module comps -> 78 | + assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 79 | + for i = 0 to Array.length comps - 1 do 80 | + match comps.(i) with 81 | + | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 82 | + | _ -> Obj.set_field o i (Obj.field n i) 83 | + done 84 | + | _ -> assert false 85 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/pervasives.ml.patch: -------------------------------------------------------------------------------- 1 | --- pervasives.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ pervasives.ml 2010-08-19 15:43:36.000000000 -0400 3 | @@ -1,3 +1,26 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | +open Ocamljs.Inline 26 | + 27 | (***********************************************************************) 28 | (* *) 29 | (* Objective Caml *) 30 | @@ -137,11 +160,15 @@ 31 | = "caml_blit_string" "noalloc" 32 | 33 | let (^) s1 s2 = 34 | - let l1 = string_length s1 and l2 = string_length s2 in 35 | - let s = string_create (l1 + l2) in 36 | - string_blit s1 0 s 0 l1; 37 | - string_blit s2 0 s l1 l2; 38 | - s 39 | + (* camlp4 doesn't like (or) above, so we do this manually *) 40 | + inline_exp 41 | + (Jslib_ast.Jbinop (_loc, Jslib_ast.Jadd, 42 | + Jslib_ast.Jcall (_loc, 43 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s1, "toString"), 44 | + Jslib_ast.Jexp_nil _loc), 45 | + Jslib_ast.Jcall (_loc, 46 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s2, "toString"), 47 | + Jslib_ast.Jexp_nil _loc))) 48 | 49 | (* Character operations -- more in module Char *) 50 | 51 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.11.2/printf.ml.patch: -------------------------------------------------------------------------------- 1 | --- printf.ml.orig 2010-08-18 14:53:57.000000000 -0400 2 | +++ printf.ml 2010-08-26 16:28:35.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -148,15 +169,6 @@ 29 | Buffer.contents b 30 | ;; 31 | 32 | -let extract_format_int conv fmt start stop widths = 33 | - let sfmt = extract_format fmt start stop widths in 34 | - match conv with 35 | - | 'n' | 'N' -> 36 | - sfmt.[String.length sfmt - 1] <- 'u'; 37 | - sfmt 38 | - | _ -> sfmt 39 | -;; 40 | - 41 | let extract_format_float conv fmt start stop widths = 42 | let sfmt = extract_format fmt start stop widths in 43 | match conv with 44 | @@ -509,20 +521,20 @@ 45 | let s = 46 | if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in 47 | cont_s (next_index spec n) s (succ i) 48 | - | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv -> 49 | + | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' -> 50 | let (x : int) = get_arg spec n in 51 | let s = 52 | - format_int (extract_format_int conv fmt pos i widths) x in 53 | + format_int (extract_format fmt pos i widths) x in 54 | cont_s (next_index spec n) s (succ i) 55 | | 'f' | 'e' | 'E' | 'g' | 'G' -> 56 | let (x : float) = get_arg spec n in 57 | let s = format_float (extract_format fmt pos i widths) x in 58 | cont_s (next_index spec n) s (succ i) 59 | - | 'F' as conv -> 60 | + | 'F' -> 61 | let (x : float) = get_arg spec n in 62 | let s = 63 | if widths = [] then Pervasives.string_of_float x else 64 | - format_float_lexeme (extract_format_float conv fmt pos i widths) x in 65 | + format_float_lexeme (extract_format fmt pos i widths) x in 66 | cont_s (next_index spec n) s (succ i) 67 | | 'B' | 'b' -> 68 | let (x : bool) = get_arg spec n in 69 | @@ -556,7 +568,7 @@ 70 | cont_s (next_index spec n) s (succ i) 71 | | _ -> 72 | let (x : int) = get_arg spec n in 73 | - let s = format_int (extract_format_int 'n' fmt pos i widths) x in 74 | + let s = format_int (extract_format fmt pos i widths) x in 75 | cont_s (next_index spec n) s (succ i) 76 | end 77 | | ',' -> cont_s n "" (succ i) 78 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/Makefile: -------------------------------------------------------------------------------- 1 | ML=$(wildcard *.ml) 2 | PATCHES=$(addsuffix .patch,$(ML)) 3 | 4 | %.ml.patch: %.ml 5 | -diff -u $<.orig $< > $@ 6 | 7 | patches: $(PATCHES) 8 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/buffer.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.12.0/buffer.ml -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/buffer.ml.orig: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaked/ocamljs/378080ff1c8033bb15ed2bd29bf1443e301d7af8/src/stdlib/patches/3.12.0/buffer.ml.orig -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/camlinternalMod.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | (***********************************************************************) 23 | (* *) 24 | (* Objective Caml *) 25 | (* *) 26 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 27 | (* *) 28 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 29 | (* en Automatique. All rights reserved. This file is distributed *) 30 | (* under the terms of the GNU Library General Public License, with *) 31 | (* the special exception on linking described in file ../LICENSE. *) 32 | (* *) 33 | (***********************************************************************) 34 | 35 | (* $Id: camlinternalMod.ml 8768 2008-01-11 16:13:18Z doligez $ *) 36 | 37 | type shape = 38 | | Function 39 | | Lazy 40 | | Class 41 | | Module of shape array 42 | 43 | let rec init_mod loc shape = 44 | match shape with 45 | | Function -> 46 | Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 47 | | Lazy -> 48 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 49 | | Class -> 50 | Obj.repr (CamlinternalOO.dummy_class loc) 51 | | Module comps -> 52 | Obj.repr (Array.map (init_mod loc) comps) 53 | 54 | let rec update_mod shape o n = 55 | match shape with 56 | | Module comps -> 57 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 58 | for i = 0 to Array.length comps - 1 do 59 | match comps.(i) with 60 | | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 61 | | _ -> Obj.set_field o i (Obj.field n i) 62 | done 63 | | _ -> assert false 64 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/camlinternalMod.ml.orig: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Objective Caml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 2004 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file ../LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: camlinternalMod.ml 8768 2008-01-11 16:13:18Z doligez $ *) 15 | 16 | type shape = 17 | | Function 18 | | Lazy 19 | | Class 20 | | Module of shape array 21 | 22 | let rec init_mod loc shape = 23 | match shape with 24 | | Function -> 25 | let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 26 | and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 27 | Obj.repr(fun _ -> 28 | ignore pad1; ignore pad2; ignore pad3; ignore pad4; 29 | ignore pad5; ignore pad6; ignore pad7; ignore pad8; 30 | raise (Undefined_recursive_module loc)) 31 | | Lazy -> 32 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 33 | | Class -> 34 | Obj.repr (CamlinternalOO.dummy_class loc) 35 | | Module comps -> 36 | Obj.repr (Array.map (init_mod loc) comps) 37 | 38 | let overwrite o n = 39 | assert (Obj.size o >= Obj.size n); 40 | for i = 0 to Obj.size n - 1 do 41 | Obj.set_field o i (Obj.field n i) 42 | done 43 | 44 | let rec update_mod shape o n = 45 | match shape with 46 | | Function -> 47 | if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 48 | then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 49 | else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 50 | | Lazy -> 51 | if Obj.tag n = Obj.lazy_tag then 52 | Obj.set_field o 0 (Obj.field n 0) 53 | else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 54 | Obj.set_tag o Obj.forward_tag; 55 | Obj.set_field o 0 (Obj.field n 0) 56 | end else begin 57 | (* forwarding pointer was shortcut by GC *) 58 | Obj.set_tag o Obj.forward_tag; 59 | Obj.set_field o 0 n 60 | end 61 | | Class -> 62 | assert (Obj.tag n = 0 && Obj.size n = 4); 63 | overwrite o n 64 | | Module comps -> 65 | assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 66 | for i = 0 to Array.length comps - 1 do 67 | update_mod comps.(i) (Obj.field o i) (Obj.field n i) 68 | done 69 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/camlinternalMod.ml.patch: -------------------------------------------------------------------------------- 1 | --- camlinternalMod.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ camlinternalMod.ml 2010-08-19 15:44:16.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -22,12 +43,7 @@ 29 | let rec init_mod loc shape = 30 | match shape with 31 | | Function -> 32 | - let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4 33 | - and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in 34 | - Obj.repr(fun _ -> 35 | - ignore pad1; ignore pad2; ignore pad3; ignore pad4; 36 | - ignore pad5; ignore pad6; ignore pad7; ignore pad8; 37 | - raise (Undefined_recursive_module loc)) 38 | + Obj.repr (fun _ -> raise (Undefined_recursive_module loc)) 39 | | Lazy -> 40 | Obj.repr (lazy (raise (Undefined_recursive_module loc))) 41 | | Class -> 42 | @@ -35,34 +51,13 @@ 43 | | Module comps -> 44 | Obj.repr (Array.map (init_mod loc) comps) 45 | 46 | -let overwrite o n = 47 | - assert (Obj.size o >= Obj.size n); 48 | - for i = 0 to Obj.size n - 1 do 49 | - Obj.set_field o i (Obj.field n i) 50 | - done 51 | - 52 | let rec update_mod shape o n = 53 | match shape with 54 | - | Function -> 55 | - if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o 56 | - then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end 57 | - else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x)) 58 | - | Lazy -> 59 | - if Obj.tag n = Obj.lazy_tag then 60 | - Obj.set_field o 0 (Obj.field n 0) 61 | - else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *) 62 | - Obj.set_tag o Obj.forward_tag; 63 | - Obj.set_field o 0 (Obj.field n 0) 64 | - end else begin 65 | - (* forwarding pointer was shortcut by GC *) 66 | - Obj.set_tag o Obj.forward_tag; 67 | - Obj.set_field o 0 n 68 | - end 69 | - | Class -> 70 | - assert (Obj.tag n = 0 && Obj.size n = 4); 71 | - overwrite o n 72 | - | Module comps -> 73 | - assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 74 | - for i = 0 to Array.length comps - 1 do 75 | - update_mod comps.(i) (Obj.field o i) (Obj.field n i) 76 | - done 77 | + | Module comps -> 78 | + assert (Obj.tag n = 0 && Obj.size n >= Array.length comps); 79 | + for i = 0 to Array.length comps - 1 do 80 | + match comps.(i) with 81 | + | Module _ -> update_mod comps.(i) (Obj.field o i) (Obj.field n i) 82 | + | _ -> Obj.set_field o i (Obj.field n i) 83 | + done 84 | + | _ -> assert false 85 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/pervasives.ml.patch: -------------------------------------------------------------------------------- 1 | --- pervasives.ml.orig 2010-08-18 14:54:59.000000000 -0400 2 | +++ pervasives.ml 2010-08-19 15:44:19.000000000 -0400 3 | @@ -1,3 +1,26 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | +open Ocamljs.Inline 26 | + 27 | (***********************************************************************) 28 | (* *) 29 | (* Objective Caml *) 30 | @@ -141,11 +164,15 @@ 31 | = "caml_blit_string" "noalloc" 32 | 33 | let (^) s1 s2 = 34 | - let l1 = string_length s1 and l2 = string_length s2 in 35 | - let s = string_create (l1 + l2) in 36 | - string_blit s1 0 s 0 l1; 37 | - string_blit s2 0 s l1 l2; 38 | - s 39 | + (* camlp4 doesn't like (or) above, so we do this manually *) 40 | + inline_exp 41 | + (Jslib_ast.Jbinop (_loc, Jslib_ast.Jadd, 42 | + Jslib_ast.Jcall (_loc, 43 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s1, "toString"), 44 | + Jslib_ast.Jexp_nil _loc), 45 | + Jslib_ast.Jcall (_loc, 46 | + Jslib_ast.Jfieldref (_loc, inline_antiexp s2, "toString"), 47 | + Jslib_ast.Jexp_nil _loc))) 48 | 49 | (* Character operations -- more in module Char *) 50 | 51 | -------------------------------------------------------------------------------- /src/stdlib/patches/3.12.0/printf.ml.patch: -------------------------------------------------------------------------------- 1 | --- printf.ml.orig 2010-08-25 18:45:35.000000000 -0400 2 | +++ printf.ml 2010-08-26 16:29:36.000000000 -0400 3 | @@ -1,3 +1,24 @@ 4 | +(* 5 | + * This file is part of ocamljs, OCaml to Javascript compiler 6 | + * Copyright (C) 2007-9 Skydeck, Inc 7 | + * Copyright (C) 2010 Jake Donham 8 | + * 9 | + * This library is free software; you can redistribute it and/or 10 | + * modify it under the terms of the GNU Library General Public 11 | + * License as published by the Free Software Foundation; either 12 | + * version 2 of the License, or (at your option) any later version. 13 | + * 14 | + * This library is distributed in the hope that it will be useful, 15 | + * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 | + * Library General Public License for more details. 18 | + * 19 | + * You should have received a copy of the GNU Library General Public 20 | + * License along with this library; if not, write to the Free 21 | + * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 22 | + * MA 02111-1307, USA 23 | + *) 24 | + 25 | (***********************************************************************) 26 | (* *) 27 | (* Objective Caml *) 28 | @@ -148,24 +169,6 @@ 29 | Buffer.contents b 30 | ;; 31 | 32 | -let extract_format_int conv fmt start stop widths = 33 | - let sfmt = extract_format fmt start stop widths in 34 | - match conv with 35 | - | 'n' | 'N' -> 36 | - sfmt.[String.length sfmt - 1] <- 'u'; 37 | - sfmt 38 | - | _ -> sfmt 39 | -;; 40 | - 41 | -let extract_format_float conv fmt start stop widths = 42 | - let sfmt = extract_format fmt start stop widths in 43 | - match conv with 44 | - | 'F' -> 45 | - sfmt.[String.length sfmt - 1] <- 'g'; 46 | - sfmt 47 | - | _ -> sfmt 48 | -;; 49 | - 50 | (* Returns the position of the next character following the meta format 51 | string, starting from position [i], inside a given format [fmt]. 52 | According to the character [conv], the meta format string is 53 | @@ -518,20 +521,20 @@ 54 | let s = 55 | if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in 56 | cont_s (next_index spec n) s (succ i) 57 | - | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv -> 58 | + | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' -> 59 | let (x : int) = get_arg spec n in 60 | let s = 61 | - format_int (extract_format_int conv fmt pos i widths) x in 62 | + format_int (extract_format fmt pos i widths) x in 63 | cont_s (next_index spec n) s (succ i) 64 | | 'f' | 'e' | 'E' | 'g' | 'G' -> 65 | let (x : float) = get_arg spec n in 66 | let s = format_float (extract_format fmt pos i widths) x in 67 | cont_s (next_index spec n) s (succ i) 68 | - | 'F' as conv -> 69 | + | 'F' -> 70 | let (x : float) = get_arg spec n in 71 | let s = 72 | if widths = [] then Pervasives.string_of_float x else 73 | - format_float_lexeme (extract_format_float conv fmt pos i widths) x in 74 | + format_float_lexeme (extract_format fmt pos i widths) x in 75 | cont_s (next_index spec n) s (succ i) 76 | | 'B' | 'b' -> 77 | let (x : bool) = get_arg spec n in 78 | @@ -565,7 +568,7 @@ 79 | cont_s (next_index spec n) s (succ i) 80 | | _ -> 81 | let (x : int) = get_arg spec n in 82 | - let s = format_int (extract_format_int 'n' fmt pos i widths) x in 83 | + let s = format_int (extract_format fmt pos i widths) x in 84 | cont_s (next_index spec n) s (succ i) 85 | end 86 | | ',' -> cont_s n "" (succ i) 87 | -------------------------------------------------------------------------------- /src/stdlib/random.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * This file is part of ocamljs, OCaml to Javascript compiler 3 | * Copyright (C) 2007-9 Skydeck, Inc 4 | * Copyright (C) 2010 Jake Donham 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Library General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2 of the License, or (at your option) any later version. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Library General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Library General Public 17 | * License along with this library; if not, write to the Free 18 | * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 19 | * MA 02111-1307, USA 20 | *) 21 | 22 | open Ocamljs.Inline 23 | 24 | let init = ignore 25 | let full_init = ignore 26 | let self_init = ignore 27 | let bits () = << Math.floor (Math.random() * 1073741824) >> 28 | let int b = << Math.floor (Math.random() * $b$) >> 29 | let int32 b = << Math.floor (Math.random() * $b$) >> 30 | let nativeint b = << Math.floor (Math.random() * $b$) >> 31 | let int64 _ = Int64.zero 32 | let float b = << Math.random() * $b$ >> 33 | let bool _ = << Math.random() < 0.5 >> 34 | 35 | module State = 36 | struct 37 | type t = unit 38 | 39 | let make = ignore 40 | let make_self_init = ignore 41 | let copy = ignore 42 | 43 | let bits _ = bits () 44 | let int _ b = int b 45 | let int32 _ b = int32 b 46 | let nativeint _ b = nativeint b 47 | let int64 _ b = int64 b 48 | let float _ b = float b 49 | let bool _ = bool () 50 | end 51 | 52 | let get_state = ignore 53 | let set_state = ignore 54 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | DIRS=jslib ocamljs stdlib 2 | 3 | all: 4 | for dir in $(DIRS); do \ 5 | $(MAKE) -C $$dir all || exit; \ 6 | done 7 | 8 | clean: 9 | for dir in $(DIRS); do \ 10 | $(MAKE) -C $$dir clean || exit; \ 11 | done 12 | -------------------------------------------------------------------------------- /test/jscomp/Makefile: -------------------------------------------------------------------------------- 1 | # e.g. SpiderMonkey at http://www.mozilla.org/js/spidermonkey/ 2 | JS=js 3 | 4 | COMPFLAGS=-warn-error A 5 | 6 | TESTS=$(basename $(wildcard *.ml)) 7 | 8 | all: $(addsuffix .test,$(TESTS)) 9 | 10 | %.js : %.ml 11 | ../../src/jscomp/jsmain.byte $(COMPFLAGS) -I ../lib -o $@ $< 12 | 13 | %.exp : %.ml 14 | ocamlc $(COMPFLAGS) -o $(basename $@) $<; \ 15 | ./$(basename $@) > $@ 16 | 17 | %.test: %.exp %.js 18 | @t=`basename $< .exp`; \ 19 | echo -n $$t ": "; \ 20 | $(JS) $$t.js > $$t.act; \ 21 | if cmp -s $$t.exp $$t.act; then \ 22 | echo "OK"; \ 23 | else \ 24 | echo "Failed"; diff $$t.exp $$t.act; \ 25 | fi 26 | 27 | clean: 28 | @for t in $(TESTS); do \ 29 | rm -f $$t $$t.js $$t.exp $$t.act $$t.cmi $$t.cmo $$t.cmjs; \ 30 | done 31 | 32 | .PRECIOUS: %.js %.exp 33 | -------------------------------------------------------------------------------- /test/jscomp/hello.ml: -------------------------------------------------------------------------------- 1 | print_endline "hello" 2 | -------------------------------------------------------------------------------- /test/jslib/Makefile: -------------------------------------------------------------------------------- 1 | all: myocamlbuild.ml 2 | ocamlbuild main.byte -- 3 | 4 | clean: 5 | ocamlbuild -clean 6 | rm -f myocamlbuild.ml 7 | 8 | myocamlbuild.ml: 9 | ln -s ../../tools/myocamlbuild.ml 10 | -------------------------------------------------------------------------------- /test/jslib/_tags: -------------------------------------------------------------------------------- 1 | <*> : pkg_oUnit,pkg_jslib 2 | -------------------------------------------------------------------------------- /test/jslib/main.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Jslib" >::: [ 4 | Parse.tests 5 | ] 6 | 7 | ;; 8 | 9 | OUnit.run_test_tt_main tests 10 | -------------------------------------------------------------------------------- /test/jslib/parse.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Jslib_ast 3 | 4 | let parse_exp_string s = 5 | Jslib_parse.Gram.parse_string 6 | Jslib_parse.expression 7 | (Jslib_parse.Gram.Loc.mk "") 8 | s 9 | 10 | let assert_exp s f = 11 | assert_bool s (f (parse_exp_string s)) 12 | 13 | let tests = "Parse" >::: [ 14 | "div" >:: begin fun () -> 15 | assert_exp 16 | "1 / 2" 17 | (function 18 | | Jbinop (_, Jdiv, Jnum (_, "1"), Jnum (_, "2")) -> true 19 | | _ -> false) 20 | end; 21 | 22 | "regexp" >:: begin fun () -> 23 | assert_exp 24 | "1 / /2/" 25 | (function 26 | | Jbinop (_, Jdiv, Jnum (_, "1"), Jregexp (_, "2", "")) -> true 27 | | _ -> false) 28 | end; 29 | ] 30 | -------------------------------------------------------------------------------- /test/ocamljs/Makefile: -------------------------------------------------------------------------------- 1 | all: myocamlbuild.ml 2 | ocamlbuild main.js; 3 | js _build/main.js 4 | 5 | clean: 6 | ocamlbuild -clean 7 | rm -f myocamlbuild.ml 8 | 9 | myocamlbuild.ml: 10 | ln -s ../../tools/myocamlbuild.ml 11 | -------------------------------------------------------------------------------- /test/ocamljs/_tags: -------------------------------------------------------------------------------- 1 | <*> : pkg_oUnit 2 | or or : syntax_camlp4o,pkg_jslib.inline,pkg_ocamljs 3 | -------------------------------------------------------------------------------- /test/ocamljs/booleans.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Ocamljs.Inline 3 | 4 | type t = { 5 | mutable x : bool; 6 | } 7 | 8 | let tests = "Booleans" >::: [ 9 | "literals" >:: begin fun () -> 10 | assert_bool "true" << true === $true$ >>; 11 | assert_bool "false" << false === $false$ >>; 12 | end; 13 | 14 | "record" >:: begin fun () -> 15 | let x = { x = false } in 16 | x.x <- true; 17 | assert_bool "" << true === $x.x$ >>; 18 | end; 19 | 20 | "match" >:: begin fun () -> 21 | (* 22 | test for true compiles to if (!= match 0); 23 | translated to if (!!match) in js since OCaml bools become js bools 24 | *) 25 | match true, true with 26 | | true, true -> () 27 | | _ -> assert_failure "fall through" 28 | end; 29 | 30 | "eq" >:: begin fun () -> 31 | let x = Some () in 32 | assert_bool "=" << false === $x = None$ >>; 33 | assert_bool "<>" << true === $x <> None$ >>; 34 | end; 35 | ] 36 | -------------------------------------------------------------------------------- /test/ocamljs/main.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Ocamljs" >::: [ 4 | Booleans.tests; 5 | Oo_class_arg.tests; 6 | Oo_class_let.tests; 7 | Oo_class.tests; 8 | Oo_cloning.tests; 9 | Oo_funobj.tests; 10 | Oo_immediate.tests; 11 | Oo_inherit.tests; 12 | Oo_init.tests; 13 | Oo_method_function_bug.tests; 14 | Oo_private.tests; 15 | Oo_self.tests; 16 | Oo_super.tests; 17 | Oo_this_bug.tests; 18 | Oo_virtual.tests; 19 | Raiseargs.tests; 20 | Tail_calls.tests; 21 | ] 22 | 23 | ;; 24 | 25 | OUnit.run_test_tt_main tests 26 | -------------------------------------------------------------------------------- /test/ocamljs/oo_class.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class point = 4 | object 5 | val mutable x = 0 6 | method get_x = x 7 | method move d = x <- x + d 8 | end 9 | 10 | let tests = "Oo_class" >:: begin fun () -> 11 | let p = new point in 12 | assert_equal p#get_x 0; 13 | p#move 10; 14 | assert_equal p#get_x 10 15 | end 16 | -------------------------------------------------------------------------------- /test/ocamljs/oo_class_arg.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class point x_init = 4 | object 5 | val mutable x = x_init 6 | method get_x = x 7 | method get_offset = x - x_init 8 | method move d = x <- x + d 9 | end 10 | 11 | let tests = "Oo_class_arg" >:: begin fun () -> 12 | let p = new point 7 in 13 | assert_equal p#get_x 7; 14 | assert_equal p#get_offset 0; 15 | p#move 10; 16 | assert_equal p#get_x 17; 17 | assert_equal p#get_offset 10 18 | end 19 | -------------------------------------------------------------------------------- /test/ocamljs/oo_class_let.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class adjusted_point x_init = 4 | let origin = (x_init / 10) * 10 in 5 | object 6 | val mutable x = origin 7 | method get_x = x 8 | method get_offset = x - origin 9 | method move d = x <- x + d 10 | end 11 | 12 | let tests = "Oo_class_let" >:: begin fun () -> 13 | let p = new adjusted_point 7 in 14 | assert_equal p#get_x 0; 15 | assert_equal p#get_offset 0; 16 | p#move 10; 17 | assert_equal p#get_x 10; 18 | assert_equal p#get_offset 10 19 | end 20 | -------------------------------------------------------------------------------- /test/ocamljs/oo_cloning.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class point x_init = 4 | object 5 | val mutable x = x_init 6 | method get_x = x 7 | method get_offset = x - x_init 8 | method move d = x <- x + d 9 | end 10 | 11 | let tests = "Oo_cloning" >:: begin fun () -> 12 | let p = new point 5 in 13 | let q = Oo.copy p in 14 | q#move 7; 15 | assert_equal p#get_x 5; 16 | assert_equal q#get_x 12; 17 | 18 | assert_bool "" (not (p = q)); 19 | assert_bool "" (p = p); 20 | end 21 | -------------------------------------------------------------------------------- /test/ocamljs/oo_funobj.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class functional_point y = 4 | object 5 | val x = y 6 | method get_x = x 7 | method move d = {< x = x + d >} 8 | end 9 | 10 | let tests = "Oo_funobj" >:: begin fun () -> 11 | let p = new functional_point 7 in 12 | assert_equal p#get_x 7; 13 | assert_equal (p#move 3)#get_x 10; 14 | assert_equal p#get_x 7; 15 | end 16 | -------------------------------------------------------------------------------- /test/ocamljs/oo_immediate.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let p = 4 | object 5 | val mutable x = 0 6 | method get_x = x 7 | method move d = x <- x + d 8 | end 9 | 10 | let tests = "Oo_immediate" >:: begin fun () -> 11 | assert_equal p#get_x 0; 12 | p#move 10; 13 | assert_equal p#get_x 10; 14 | end 15 | -------------------------------------------------------------------------------- /test/ocamljs/oo_inherit.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class point x_init = 4 | object 5 | val mutable x = x_init 6 | method get_x = x 7 | method get_offset = x - x_init 8 | method move d = x <- x + d 9 | end 10 | 11 | class colored_point x (c : string) = 12 | object 13 | inherit point x 14 | val c = c 15 | method color = c 16 | end 17 | 18 | let tests = "Oo_inherit" >:: begin fun () -> 19 | let p = new colored_point 5 "red" in 20 | assert_equal p#get_x 5; 21 | assert_equal p#color "red"; 22 | end 23 | -------------------------------------------------------------------------------- /test/ocamljs/oo_init.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let z = ref false 4 | 5 | class printable_point x_init = 6 | let origin = (x_init / 10) * 10 in 7 | object (self) 8 | val mutable x = origin 9 | method get_x = x 10 | method move d = x <- x + d 11 | initializer z := true 12 | end 13 | 14 | let tests = "Oo_init" >:: begin fun () -> 15 | ignore (new printable_point 17); 16 | assert_bool "" !z 17 | end 18 | 19 | -------------------------------------------------------------------------------- /test/ocamljs/oo_method_function_bug.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Ocamljs.Inline 3 | 4 | let foo x = x + 1 5 | 6 | let o = 7 | object 8 | method foo = foo 9 | method bar x = x + 1 10 | end 11 | 12 | let tests = "Oo_method_function_bug" >:: begin fun () -> 13 | assert_equal (o#bar 1) 2; 14 | assert_equal << $o$.bar(1) >> 2; 15 | assert_equal (o#foo 1) 2; 16 | assert_equal << $o$.foo(1) >> 2; 17 | end 18 | -------------------------------------------------------------------------------- /test/ocamljs/oo_private.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class restricted_point x_init = 4 | object (self) 5 | val mutable x = x_init 6 | method get_x = x 7 | method private move d = x <- x + d 8 | method bump = self#move 1 9 | end 10 | 11 | class point_again x = 12 | object (self) 13 | inherit restricted_point x 14 | method virtual move : _ 15 | end 16 | 17 | let tests = "Oo_private" >:: begin fun () -> 18 | let p = new restricted_point 7 in 19 | assert_equal p#get_x 7; 20 | p#bump; 21 | assert_equal p#get_x 8; 22 | let p = new point_again 7 in 23 | assert_equal p#get_x 7; 24 | p#move 10; 25 | assert_equal p#get_x 17 26 | end 27 | -------------------------------------------------------------------------------- /test/ocamljs/oo_self.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class printable_point x_init = 4 | object (s) 5 | val mutable x = x_init 6 | method get_x = x 7 | method move d = x <- x + d 8 | method print = string_of_int s#get_x 9 | end 10 | 11 | let tests = "Oo_self" >:: begin fun () -> 12 | let p = new printable_point 7 in 13 | assert_equal p#print "7"; 14 | p#move 10; 15 | assert_equal p#print "17" 16 | end 17 | -------------------------------------------------------------------------------- /test/ocamljs/oo_super.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class printable_point x_init = 4 | object (s) 5 | val mutable x = x_init 6 | method get_x = x 7 | method move d = x <- x + d 8 | method print = string_of_int s#get_x 9 | end 10 | 11 | class printable_colored_point y c = 12 | object (self) 13 | val c = c 14 | method color = c 15 | inherit printable_point y as super 16 | method move1 n = 17 | super#move n 18 | method print = 19 | super#print ^ self#color 20 | end 21 | 22 | let tests = "Oo_super" >:: begin fun () -> 23 | let p = new printable_colored_point 5 "red" in 24 | p#move1 10; 25 | assert_equal p#print "15red" 26 | end 27 | -------------------------------------------------------------------------------- /test/ocamljs/oo_this_bug.ml: -------------------------------------------------------------------------------- 1 | (* 2 | in Javascript this is not lexically scoped; it's rebound when you 3 | apply a function. unfortunately we do that all over the place (for 4 | OCaml level function applications and also to implement local 5 | variable binding) so we need to keep track of this in a regular 6 | variable. 7 | *) 8 | 9 | open OUnit 10 | 11 | class foo = 12 | object (self) 13 | method test1 = 14 | "test" 15 | method test2 = 16 | (fun () -> self#test1)() 17 | end 18 | 19 | let tests = "Oo_this_bug" >:: begin fun () -> 20 | assert_equal (new foo)#test2 "test" 21 | end 22 | -------------------------------------------------------------------------------- /test/ocamljs/oo_virtual.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | class virtual abstract_point x_init = 4 | object (self) 5 | method virtual get_x : int 6 | method get_offset = self#get_x - x_init 7 | method virtual move : int -> unit 8 | end 9 | 10 | class point x_init = 11 | object 12 | inherit abstract_point x_init 13 | val mutable x = x_init 14 | method get_x = x 15 | method move d = x <- x + d 16 | end 17 | 18 | class virtual abstract_point2 = 19 | object 20 | val mutable virtual x : int 21 | method move d = x <- x + d 22 | end 23 | 24 | class point2 x_init = 25 | object 26 | inherit abstract_point2 27 | val mutable x = x_init 28 | method get_offset = x - x_init 29 | end 30 | 31 | let tests = "Oo_virtual" >:: begin fun () -> 32 | let p = new point 7 in 33 | assert_equal p#get_offset 0; 34 | p#move 10; 35 | assert_equal p#get_offset 10; 36 | 37 | let p2 = new point2 7 in 38 | assert_equal p2#get_offset 0; 39 | p2#move 10; 40 | assert_equal p2#get_offset 10; 41 | end 42 | -------------------------------------------------------------------------------- /test/ocamljs/raiseargs.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | type 'a triple = Smaller of 'a * 'a * 'a | Bigger of 'a * 'a * 'a 4 | 5 | let print_triple tr = match tr with 6 | | Smaller(l,m,s) 7 | | Bigger (s,m,l) -> 8 | s ^ " " ^ m ^ " " ^ l 9 | 10 | let tests = "Raisargs" >:: begin fun () -> 11 | assert_equal (print_triple (Smaller("Large", "Medium", "Small"))) "Small Medium Large"; 12 | assert_equal (print_triple (Bigger ("Small", "Medium", "Large"))) "Small Medium Large"; 13 | end 14 | -------------------------------------------------------------------------------- /test/ocamljs/tail_calls.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Ocamljs.Inline 3 | 4 | let tests = "Tail_calls" >::: [ 5 | "enough recursion" >:: begin fun () -> 6 | let rec loop = function 7 | | 0 -> true 8 | | n -> loop (n - 1) in 9 | (* SpiderMonkey has 999 frame limit *) 10 | assert_bool "" (loop 10000); 11 | end; 12 | 13 | "tail call from js callback" >:: begin fun () -> 14 | (* simulate a callback by setting $in_tail false *) 15 | let foo () = 3 in 16 | let bar () = foo () in 17 | let baz = 0 in 18 | <:stmt< 19 | $$in_tail = false; 20 | $baz$ = $bar$ (); 21 | >>; 22 | assert_equal baz 3 23 | end; 24 | 25 | (* 26 | maybe wrap <:stmt< >> in $in_tail off / on? 27 | 28 | "tail call from inline js" >:: begin fun () -> 29 | let foo () = 3 in 30 | let bar () = foo () in 31 | let baz = 0 in 32 | <:stmt< 33 | $baz$ = $bar$ (); 34 | >>; 35 | assert_equal baz 3 36 | end; 37 | *) 38 | 39 | "tail call from js" >:: begin fun () -> 40 | let foo () = 3 in 41 | let bar () = foo () in 42 | let baz = 0 in 43 | let (js : unit -> unit) = << function () { $exp:baz$ = $bar$ (); } >> in 44 | js (); 45 | assert_equal baz 3 46 | end; 47 | ] 48 | -------------------------------------------------------------------------------- /test/stdlib/Makefile: -------------------------------------------------------------------------------- 1 | all: myocamlbuild.ml 2 | ocamlbuild main.js; 3 | js _build/main.js 4 | 5 | clean: 6 | ocamlbuild -clean 7 | rm -f myocamlbuild.ml 8 | 9 | myocamlbuild.ml: 10 | ln -s ../../tools/myocamlbuild.ml 11 | -------------------------------------------------------------------------------- /test/stdlib/_tags: -------------------------------------------------------------------------------- 1 | <*> : pkg_oUnit 2 | -------------------------------------------------------------------------------- /test/stdlib/main.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Stdlib" >::: [ 4 | Stdlib_array.tests; 5 | Stdlib_hashtbl.tests; 6 | Stdlib_pervasives.tests; 7 | Stdlib_printf.tests; 8 | Stdlib_lexing.tests; 9 | Stdlib_parsing_tests.tests; 10 | ] 11 | 12 | ;; 13 | 14 | OUnit.run_test_tt_main tests 15 | -------------------------------------------------------------------------------- /test/stdlib/stdlib_array.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Stdlib_array" >::: [ 4 | "sort" >:: begin fun () -> 5 | let a = [| "foo"; "bar"; "baz"; "quux" |] in 6 | Array.sort compare a; 7 | assert_equal a [| "bar"; "baz"; "foo"; "quux" |]; 8 | end; 9 | ] 10 | -------------------------------------------------------------------------------- /test/stdlib/stdlib_hashtbl.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Stdlib_hashtbl" >:: begin fun () -> 4 | let t = Hashtbl.create 7 in 5 | Hashtbl.add t "foo" "bar"; 6 | Hashtbl.add t "foo" "baz"; 7 | assert_equal (Hashtbl.find t "foo") "baz"; 8 | 9 | let t = Hashtbl.create 7 in 10 | Hashtbl.add t `Foo "bar"; 11 | Hashtbl.add t `Foo "baz"; 12 | assert_equal (Hashtbl.find t `Foo) "baz" 13 | end 14 | -------------------------------------------------------------------------------- /test/stdlib/stdlib_parsing_tests.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Stdlib_parsing_stuff.Parsetree 3 | 4 | let tests = "Stdlib_parsing" >::: [ 5 | "parse" >:: begin fun() -> 6 | let lexbuf = Lexing.from_string "type t = unit" in 7 | (* ignore (Parsing.set_trace true); *) 8 | match Stdlib_parsing.implementation Stdlib_lexing.token lexbuf with 9 | | [ { pstr_desc = Pstr_type [ "t", _ ] } ] -> () 10 | | _ -> assert_failure "" 11 | end 12 | ] 13 | -------------------------------------------------------------------------------- /test/stdlib/stdlib_printf.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | let tests = "Stdlib_printf" >::: [ 4 | "1" >:: begin fun () -> assert_equal (Printf.sprintf "%d %i %n %l %L %N" 1 2 3 4 5 6) "1 2 3 4 5 6" end; 5 | "2" >:: begin fun () -> assert_equal (Printf.sprintf "%u %x %X %o" 10 12 13 14) "10 c D 16" end; 6 | "3" >:: begin fun () -> assert_equal (Printf.sprintf "%s %S" "foo" "bar") "foo \"bar\"" end; 7 | "4" >:: begin fun () -> assert_equal (Printf.sprintf "%c %C" 'a' 'b') "a 'b'" end; 8 | "5" >:: begin fun () -> 9 | let two = match Sys.ocaml_version with "3.11.1" -> "2.000000" | _ -> "2." in (* bug 3.11.1 *) 10 | assert_equal (Printf.sprintf "%f %F %e %E %g %G" 1.0 2.0 3.0 4.0 5.0 6.0) ("1.000000 " ^ two ^ " 3.000000e+00 4.000000E+00 5 6") 11 | end; 12 | "6" >:: begin fun () -> assert_equal (Printf.sprintf "%B %b" true false) "true false" end; 13 | "7" >:: begin fun () -> assert_equal (Printf.sprintf "%nd %ni %nu %nx %nX %no" 1n 2n 3n 4n 5n 6n) "1 2 3 4 5 6" end; 14 | ] 15 | --------------------------------------------------------------------------------