diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index 10b9680bfe..850c7c289c 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -297,6 +297,7 @@ let add_file f = match provides with | None -> always_included := {filename = f; program = code} :: !always_included | Some (pi, name, kind, ka) -> + let code = Macro.f code in let module J = Javascript in let rec find = function | [] -> None diff --git a/compiler/lib/macro.ml b/compiler/lib/macro.ml new file mode 100644 index 0000000000..29de3d3c16 --- /dev/null +++ b/compiler/lib/macro.ml @@ -0,0 +1,51 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2019 Ty Overby, Jane Street Group LLC + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +open Stdlib + +class macro_mapper = + object (m) + inherit Js_traverse.map as super + + method expression x = + let module J = Javascript in + match x with + | J.ECall (J.EVar (J.S {name; _}), args, _) -> ( + match name, args with + | "BLOCK", J.ENum tag :: (_ :: _ as args) -> + let tag = Int32.to_int (J.Num.to_int32 tag) in + let args = List.map args ~f:m#expression in + Mlvalue.Block.make ~tag ~args + | "TAG", [e] -> Mlvalue.Block.tag (m#expression e) + | "LENGTH", [e] -> Mlvalue.Array.length (m#expression e) + | "FIELD", [e; J.ENum n] -> + let idx = Int32.to_int (J.Num.to_int32 n) in + Mlvalue.Block.field (m#expression e) idx + | "FIELD", [_; J.EUn (J.Neg, _)] -> + failwith "Negative field indexes are not allowed" + | "ISBLOCK", [e] -> Mlvalue.is_block (m#expression e) + | ("BLOCK" | "TAG" | "LENGTH" | "FIELD" | "ISBLOCK"), _ -> + failwith (Format.sprintf "macro %s called with inappropriate arguments" name) + | _ -> super#expression x) + | _ -> super#expression x + end + +let f js = + let trav = new macro_mapper in + trav#program js diff --git a/compiler/lib/macro.mli b/compiler/lib/macro.mli new file mode 100644 index 0000000000..1d67c8500c --- /dev/null +++ b/compiler/lib/macro.mli @@ -0,0 +1,20 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2019 Ty Overby, Jane Street Group LLC + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +val f : Javascript.program -> Javascript.program diff --git a/compiler/tests/macro.ml b/compiler/tests/macro.ml new file mode 100644 index 0000000000..5ea117a242 --- /dev/null +++ b/compiler/tests/macro.ml @@ -0,0 +1,109 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2019 Ty Overby + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +module Jsoo = Js_of_ocaml_compiler + +let print_macro_transformed source = + let buffer = Buffer.create (String.length source) in + let pp = Jsoo.Pretty_print.to_buffer buffer in + Jsoo.Pretty_print.set_compact pp false; + let source = source |> Util.Filetype.js_text_of_string |> Util.Filetype.write_js in + let parsed = Util.parse_js source in + let transformed = Jsoo.Macro.f parsed in + Jsoo.Js_output.program pp transformed; + print_endline (Buffer.contents buffer) + +let print_macro_transformed source = + try print_macro_transformed source with Failure s -> Format.printf "failure: %s" s + +let%expect_test "BLOCK()" = + print_macro_transformed "BLOCK()"; + [%expect {| failure: macro BLOCK called with inappropriate arguments |}] + +let%expect_test "TAG()" = + print_macro_transformed "TAG()"; + [%expect {| failure: macro TAG called with inappropriate arguments |}] + +let%expect_test "LENGTH()" = + print_macro_transformed "LENGTH()"; + [%expect {| failure: macro LENGTH called with inappropriate arguments |}] + +let%expect_test "FIELD()" = + print_macro_transformed "FIELD()"; + [%expect {| failure: macro FIELD called with inappropriate arguments |}] + +let%expect_test "ISBLOCK()" = + print_macro_transformed "ISBLOCK()"; + [%expect {| failure: macro ISBLOCK called with inappropriate arguments |}] + +let%expect_test "BLOCK(1)" = + print_macro_transformed "BLOCK(1)"; + [%expect {| failure: macro BLOCK called with inappropriate arguments |}] + +let%expect_test "BLOCK(tag)" = + print_macro_transformed "BLOCK(tag)"; + [%expect {| failure: macro BLOCK called with inappropriate arguments |}] + +let%expect_test "BLOCK(1, a)" = + print_macro_transformed "BLOCK(1, a)"; + [%expect {| [1,a]; |}] + +let%expect_test "BLOCK(1, a, b, c)" = + print_macro_transformed "BLOCK(1, a, b, c)"; + [%expect {| [1,a,b,c]; |}] + +let%expect_test "BLOCK(077, a)" = + print_macro_transformed "BLOCK(077, a)"; + [%expect {| [63,a]; |}] + +let%expect_test "BLOCK(0779, a)" = + print_macro_transformed "BLOCK(0779, a)"; + [%expect {| [779,a]; |}] + +let%expect_test "TAG(a)" = + print_macro_transformed "TAG(a)"; + [%expect {| a[0]; |}] + +let%expect_test "LENGTH(a)" = + print_macro_transformed "LENGTH(a)"; + [%expect {| a.length - 1; |}] + +let%expect_test "FIELD(a)" = + print_macro_transformed "FIELD(a)"; + [%expect {| failure: macro FIELD called with inappropriate arguments |}] + +let%expect_test "FIELD(a, b)" = + print_macro_transformed "FIELD(a, b)"; + [%expect {| failure: macro FIELD called with inappropriate arguments |}] + +let%expect_test "FIELD(a, b << 5)" = + print_macro_transformed "FIELD(a, b << 5)"; + [%expect {| failure: macro FIELD called with inappropriate arguments |}] + +let%expect_test "FIELD(a, 0)" = + print_macro_transformed "FIELD(a, 0)"; + [%expect {| a[1]; |}] + +let%expect_test "FIELD(a, -1)" = + print_macro_transformed "FIELD(a, -1)"; + [%expect {| failure: Negative field indexes are not allowed |}] + +let%expect_test "ISBLOCK(a)" = + print_macro_transformed "ISBLOCK(a)"; + [%expect {| typeof a !== "number"; |}] diff --git a/runtime/unix.js b/runtime/unix.js index e30b2b6b08..aecc6c0ed4 100644 --- a/runtime/unix.js +++ b/runtime/unix.js @@ -15,10 +15,10 @@ function unix_gmtime (t) { var d_num = d.getTime(); var januaryfirst = (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime(); var doy = Math.floor((d_num - januaryfirst) / 86400000); - return [0, d.getUTCSeconds(), d.getUTCMinutes(), d.getUTCHours(), + return BLOCK(0, d.getUTCSeconds(), d.getUTCMinutes(), d.getUTCHours(), d.getUTCDate(), d.getUTCMonth(), d.getUTCFullYear() - 1900, d.getUTCDay(), doy, - false | 0 /* for UTC daylight savings time is false */] + false | 0 /* for UTC daylight savings time is false */) } //Provides: unix_localtime @@ -30,10 +30,10 @@ function unix_localtime (t) { var jan = new Date(d.getFullYear(), 0, 1); var jul = new Date(d.getFullYear(), 6, 1); var stdTimezoneOffset = Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset()); - return [0, d.getSeconds(), d.getMinutes(), d.getHours(), + return BLOCK(0, d.getSeconds(), d.getMinutes(), d.getHours(), d.getDate(), d.getMonth(), d.getFullYear() - 1900, d.getDay(), doy, - (d.getTimezoneOffset() < stdTimezoneOffset) | 0 /* daylight savings time field. */] + (d.getTimezoneOffset() < stdTimezoneOffset) | 0 /* daylight savings time field. */) } //Provides: unix_mktime @@ -42,7 +42,7 @@ function unix_mktime(tm){ var d = (new Date(tm[6]+1900,tm[5],tm[4],tm[3],tm[2],tm[1])).getTime(); var t = Math.floor(d / 1000); var tm2 = unix_localtime(t); - return [0,t,tm2]; + return BLOCK(0,t,tm2); } //Provides: win_startup const