From 2cf831c180081d053865bbcf2656d80d296a4c76 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 26 May 2026 09:42:35 +0200 Subject: [PATCH] A mostly AI coded js-maker, supervised by me. --- README.md | 152 ++- demo/dom-exercises.generated.js | 152 +++ demo/dom-exercises.rkt | 83 ++ demo/js-usecases.generated.js | 312 +++++++ demo/js-usecases.rkt | 304 ++++++ demo/show-jsmaker-output.rkt | 32 + demo/show-optimized.rkt | 16 + info.rkt | 41 + main.rkt | 1185 ++++++++++++++++++++++++ private/syntax-helpers.rkt | 42 + private/utils.rkt | 209 +++++ scrbl/.gitignore | 5 + scrbl/jsmaker.scrbl | 245 +++++ scrbl/usecases.scrbl | 584 ++++++++++++ testing/jsmaker-dom-exercises.rkt | 68 ++ testing/jsmaker-executors.rkt | 164 ++++ testing/jsmaker-program-regression.rkt | 118 +++ testing/jsmaker-regexp-regression.rkt | 24 + testing/jsmaker-regression.rkt | 110 +++ testing/jsmaker-regressions.rkt | 7 + testing/jsmaker-test-framework.rkt | 88 ++ testing/jsmaker-test-runner.rkt | 12 + testing/jsmaker-usecases.rkt | 191 ++++ 23 files changed, 4143 insertions(+), 1 deletion(-) create mode 100644 demo/dom-exercises.generated.js create mode 100644 demo/dom-exercises.rkt create mode 100644 demo/js-usecases.generated.js create mode 100644 demo/js-usecases.rkt create mode 100644 demo/show-jsmaker-output.rkt create mode 100644 demo/show-optimized.rkt create mode 100644 info.rkt create mode 100644 main.rkt create mode 100644 private/syntax-helpers.rkt create mode 100644 private/utils.rkt create mode 100644 scrbl/.gitignore create mode 100644 scrbl/jsmaker.scrbl create mode 100644 scrbl/usecases.scrbl create mode 100644 testing/jsmaker-dom-exercises.rkt create mode 100644 testing/jsmaker-executors.rkt create mode 100644 testing/jsmaker-program-regression.rkt create mode 100644 testing/jsmaker-regexp-regression.rkt create mode 100644 testing/jsmaker-regression.rkt create mode 100644 testing/jsmaker-regressions.rkt create mode 100644 testing/jsmaker-test-framework.rkt create mode 100644 testing/jsmaker-test-runner.rkt create mode 100644 testing/jsmaker-usecases.rkt diff --git a/README.md b/README.md index dcad8e3..56fc0b6 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,153 @@ # js-maker -Converts simple scheme expressions to javascript for use as javascript code. \ No newline at end of file +A syntax-driven Racket-to-JavaScript macro experiment. + +## Layout + +```text +jsmaker/ + main.rkt public macro module + info.rkt package metadata and package test entry + private/ + syntax-helpers.rkt compatibility/helper material + utils.rkt compatibility/helper material + scrbl/ + jsmaker.scrbl Scribble documentation + testing/ + jsmaker-executors.rkt JavaScript engine discovery/execution + jsmaker-test-framework.rkt JS regression framework + jsmaker-test-runner.rkt old-name compatibility wrapper + jsmaker-regression.rkt core expression tests + jsmaker-regexp-regression.rkt regexp tests + jsmaker-program-regression.rkt larger program tests + jsmaker-regressions.rkt aggregate test entry + demo/ + show-jsmaker-output.rkt + show-optimized.rkt +``` + +## Notes on private helpers + +Static analysis of this package layout shows that `main.rkt`, the test +infrastructure, the regression tests, demos and Scribble documentation do not +require `private/utils.rkt` or `private/syntax-helpers.rkt`. Those files are +retained as compatibility material from the source project and are omitted from +compilation and the package test entry point in `info.rkt`. + +The current public module has no dependency on Gregor or the old helper +modules. Gregor-style date/time forms are translated syntactically by +`main.rkt` into a small JavaScript-side representation. + +## Added language support + +This package includes conservative support for: + +- `(with-handlers ([exn? handler]) body ...)`, translated to JavaScript + `try`/`catch`. Only generic `exn?` predicates are accepted. +- Gregor-style local names such as `date`, `time`, `moment`, `parse-date`, + `parse-time`, `parse-moment`, `date->string`, `time->string`, `->year`, + `->month`, `->day`, `->hours`, `->minutes`, `->seconds`, `->js-date`, and + `js-date->datetime`. Import prefixes are deliberately not hardcoded; the + compiler matches on the local identifier name after any `prefix:` part. + +## Run tests + +From the directory above `jsmaker`: + +```bash +raco make jsmaker/main.rkt jsmaker/testing/jsmaker-regressions.rkt \ + jsmaker/scrbl/jsmaker.scrbl +racket jsmaker/testing/jsmaker-regressions.rkt +raco test -p jsmaker +``` + +The test framework looks for JavaScript engines such as `node`, `deno`, +`bun`, `qjs`, `d8`, `jsc`, `js`. Chromium is only used when explicitly selected +or when `JSMAKER_BROWSER_FALLBACK=1` is set. + +When no JavaScript engine is available, the tests generate the JavaScript test +files and print warnings, but do not fail unless `JSMAKER_REQUIRE_ENGINE` or +`JSMAKER_REQUIRE_NODE` is set. + +Useful environment variables: + +```bash +JSMAKER_ENGINE=auto|node|deno|bun|qjs|d8|jsc|js|chromium +JSMAKER_ENGINE_PATH=/path/to/executable +JSMAKER_NODE=/path/to/node +JSMAKER_REQUIRE_ENGINE=1 +JSMAKER_ENGINE_TIMEOUT_SECONDS=15 +JSMAKER_BROWSER_FALLBACK=1 +``` + +## Suggested start prompt for future work + +Use this prompt when asking ChatGPT to make a new Racket module or extend this +one: + +```text +Werk aan een Racket-module/package in een versievaste buildmap. + +Belangrijk: +- Maak altijd een nieuwe submap voor de oplevering, bijvoorbeeld + /mnt/data/-build-NNN/. +- Werk niet direct in /mnt/data met losse bestanden met dezelfde naam; + voorkom versieverwarring door alles in die buildmap te kopi毛ren/patchen. +- Houd de package-structuur stabiel: + - main.rkt voor de publieke module; + - private/ voor helpers en utils; + - testing/ voor test-infrastructuur en regressietests; + - demo/ voor demonstratiebestanden; + - info.rkt voor package metadata en test entry points. +- Pas require-paden aan op die structuur voordat je test. +- Test met Racket zelf, bijvoorbeeld: + /tmp/racket/bin/raco make /main.rkt /testing/.rkt + /tmp/racket/bin/racket /testing/.rkt +- Als JavaScript nodig is, gebruik een aparte executor/test-framework module. + Tests mogen niet falen alleen omdat node/deno/bun/qjs ontbreekt; ze moeten + dan skippen met duidelijke warnings, tenzij een REQUIRE-envvar is gezet. +- Gebruik geen shell-internet voor dependencies. Als packages nodig zijn, haal + ze via de rktsndbx bootstrap/package-index flow op. +- Lever na afloop een zip van exact de geteste buildmap op. +- Rapporteer kort welke commando's zijn uitgevoerd, wat de testresultaten waren, + en welke zip het geteste resultaat bevat. +``` + + +## Latest tested fix + +This build includes the `with-handlers` callee-position fix for inline lambda +handlers, including rest-argument handlers such as `(lambda args ...)`. It also +adds a Racket-like division-by-zero runtime check for `/`, so the generic +`exn?` handler subset can catch `(/ 10 0)`. + +## JavaScript use case demos + +The package includes a larger set of JavaScript use case snippets in +`demo/js-usecases.rkt`. They are written in the Racket surface syntax accepted +by `js` and compiled to JavaScript by the macro. The generated JavaScript is +also written to `demo/js-usecases.generated.js`. + +The corresponding regression tests live in `testing/jsmaker-usecases.rkt` and +are included by `testing/jsmaker-regressions.rkt`. The test framework now awaits +Promise-valued tests, so asynchronous examples such as the Fetch API can be +checked with Node as well. + +Covered use cases include random numbers, `Set`, JavaScript falsey values, +currying, object destructuring, `setInterval`/`clearInterval`, object property +get/set/delete, string concatenation order, `Object.freeze`/`Object.seal`, +switch/case, classes with constructor defaults, sorting objects, array deletion +techniques, Bubble Sort, recursive Binary Search, `Map` counting, DOM HTML +access, anagram checks, pair-sum checks, and Fetch API result/error handling. + +## Use-case documentation + +The file `scrbl/usecases.scrbl` documents the JavaScript use cases from +`demo/js-usecases.rkt`. Each use case is shown as Racket/js-maker source next +to representative generated JavaScript, followed by the behavior covered by the +regression test. + +The use-case tests in `testing/jsmaker-usecases.rkt` intentionally use +`js/expression` for the test calls wherever possible. Raw JavaScript is kept +only for small test-harness preambles such as fake timers, fake DOM objects, and +fake fetch. diff --git a/demo/dom-exercises.generated.js b/demo/dom-exercises.generated.js new file mode 100644 index 0000000..22ce082 --- /dev/null +++ b/demo/dom-exercises.generated.js @@ -0,0 +1,152 @@ +// exercise01 +{ + let p = document.querySelector("p"); + p.innerHTML = ((__rkt_body) => { + const __rkt_to_regexp = (__pat, __global) => { + const __flags = (__pat instanceof RegExp) + ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('') + : (__global ? 'g' : ''); + return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags); + }; + const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x)); + const __rkt_replacement = (__s) => { + if (typeof __s !== 'string') return __s; + let __out = ''; + for (let __i = 0; __i < __s.length; __i++) { + const __ch = __s[__i]; + if (__ch === '$') { __out += '$$'; continue; } + if (__ch === '\\' && __i + 1 < __s.length) { + const __n = __s[++__i]; + if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n)); + else __out += __n; + } else __out += __ch; + } + return __out; + }; + return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement); + })((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => String(p.innerHTML).replace(__rkt_to_regexp(new RegExp("\\b\\w{9,}\\b"), true), __rkt_replacement(function(word) { + return ("" + word + ""); + }))); +} + +// exercise02 +{ + let p = document.querySelector("p"); + p.insertAdjacentHTML("afterend", "Source: ForceM Ipsum"); +} + +// exercise03 +{ + let p = document.querySelector("p"); + p.innerHTML = ((__rkt_body) => { + const __rkt_to_regexp = (__pat, __global) => { + const __flags = (__pat instanceof RegExp) + ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('') + : (__global ? 'g' : ''); + return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags); + }; + const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x)); + const __rkt_replacement = (__s) => { + if (typeof __s !== 'string') return __s; + let __out = ''; + for (let __i = 0; __i < __s.length; __i++) { + const __ch = __s[__i]; + if (__ch === '$') { __out += '$$'; continue; } + if (__ch === '\\' && __i + 1 < __s.length) { + const __n = __s[++__i]; + if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n)); + else __out += __n; + } else __out += __ch; + } + return __out; + }; + return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement); + })((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => String(p.textContent).replace(__rkt_to_regexp(new RegExp("\\.\\s*"), true), __rkt_replacement(".
"))); +} + +// exercise04 +{ + let heading = document.querySelector("h1"); + let p = document.querySelector("p"); + let words = ((__rkt_body) => { + const __rkt_to_regexp = (__pat, __global) => { + const __flags = (__pat instanceof RegExp) + ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('') + : (__global ? 'g' : ''); + return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags); + }; + const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x)); + const __rkt_replacement = (__s) => { + if (typeof __s !== 'string') return __s; + let __out = ''; + for (let __i = 0; __i < __s.length; __i++) { + const __ch = __s[__i]; + if (__ch === '$') { __out += '$$'; continue; } + if (__ch === '\\' && __i + 1 < __s.length) { + const __n = __s[++__i]; + if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n)); + else __out += __n; + } else __out += __ch; + } + return __out; + }; + return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement); + })((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => String(p.textContent).split(__rkt_to_regexp(new RegExp(" "), true))); + let count = (words).length; + heading.insertAdjacentHTML("afterend", ("

" + String(count) + " words

")); +} + +// exercise05 +{ + let p = document.querySelector("p"); + let step = ((__rkt_body) => { + const __rkt_to_regexp = (__pat, __global) => { + const __flags = (__pat instanceof RegExp) + ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('') + : (__global ? 'g' : ''); + return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags); + }; + const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x)); + const __rkt_replacement = (__s) => { + if (typeof __s !== 'string') return __s; + let __out = ''; + for (let __i = 0; __i < __s.length; __i++) { + const __ch = __s[__i]; + if (__ch === '$') { __out += '$$'; continue; } + if (__ch === '\\' && __i + 1 < __s.length) { + const __n = __s[++__i]; + if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n)); + else __out += __n; + } else __out += __ch; + } + return __out; + }; + return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement); + })((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => String(p.innerHTML).replace(__rkt_to_regexp(new RegExp("\\?"), true), __rkt_replacement("馃"))); + let out = ((__rkt_body) => { + const __rkt_to_regexp = (__pat, __global) => { + const __flags = (__pat instanceof RegExp) + ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('') + : (__global ? 'g' : ''); + return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags); + }; + const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x)); + const __rkt_replacement = (__s) => { + if (typeof __s !== 'string') return __s; + let __out = ''; + for (let __i = 0; __i < __s.length; __i++) { + const __ch = __s[__i]; + if (__ch === '$') { __out += '$$'; continue; } + if (__ch === '\\' && __i + 1 < __s.length) { + const __n = __s[++__i]; + if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n)); + else __out += __n; + } else __out += __ch; + } + return __out; + }; + return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement); + })((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => String(step).replace(__rkt_to_regexp(new RegExp("!"), true), __rkt_replacement("馃槻"))); + p.innerHTML = out; +} + diff --git a/demo/dom-exercises.rkt b/demo/dom-exercises.rkt new file mode 100644 index 0000000..bf4fbd7 --- /dev/null +++ b/demo/dom-exercises.rkt @@ -0,0 +1,83 @@ +#lang racket/base + +(require "../main.rkt") + +(provide exercise01 + exercise02 + exercise03 + exercise04 + exercise05 + all-dom-exercises + show-dom-exercises) + +;; JavaScript DOM Exercises 01 Tutorial: https://youtu.be/EHF7xBUAmrQ + +;; Exercise 01 +;; Highlight all words over 8 characters long in the paragraph text. +(define exercise01 + (js + (let* ([p (send document querySelector "p")]) + (set! p.innerHTML + (regexp-replace* #px"\\b\\w{9,}\\b" + p.innerHTML + (位 (word) + (string-append "" + word + ""))))))) + +;; Exercise 02 +;; Add a link back to the source of the text after the paragraph tag. +(define exercise02 + (js + (let* ([p (send document querySelector "p")]) + (send p insertAdjacentHTML + "afterend" + "Source: ForceM Ipsum")))) + +;; Exercise 03 +;; Split each new sentence on to a separate line in the paragraph text. +;; A sentence is assumed to be terminated with a period. +(define exercise03 + (js + (let* ([p (send document querySelector "p")]) + (set! p.innerHTML + (regexp-replace* #rx"\\.\\s*" p.textContent ".
"))))) + +;; Exercise 04 +;; Count the number of words in the paragraph tag and display the count +;; after the heading. Words are separated by one singular whitespace. +(define exercise04 + (js + (let* ([heading (send document querySelector "h1")] + [p (send document querySelector "p")] + [words (regexp-split #rx" " p.textContent)] + [count (length words)]) + (send heading insertAdjacentHTML + "afterend" + (string-append "

" (number->string count) " words

"))))) + +;; Exercise 05 +;; Replace question marks with thinking faces and exclamation marks with +;; astonished faces. +(define exercise05 + (js + (let* ([p (send document querySelector "p")] + [step (regexp-replace* #rx"\\?" p.innerHTML "馃")] + [out (regexp-replace* #rx"!" step "馃槻")]) + (set! p.innerHTML out)))) + +(define all-dom-exercises + `((exercise01 . ,exercise01) + (exercise02 . ,exercise02) + (exercise03 . ,exercise03) + (exercise04 . ,exercise04) + (exercise05 . ,exercise05))) + +(define (show-dom-exercises) + (for ([entry (in-list all-dom-exercises)]) + (displayln (format "// ~a" (car entry))) + (displayln (cdr entry)) + (newline))) + +(module+ main + (show-dom-exercises)) diff --git a/demo/js-usecases.generated.js b/demo/js-usecases.generated.js new file mode 100644 index 0000000..b73489d --- /dev/null +++ b/demo/js-usecases.generated.js @@ -0,0 +1,312 @@ +// Generated by demo/js-usecases.rkt +// Each use case is wrapped in a function so snippets with return are valid. + +// random-number +function run_random_number() { +function randomBetween1And5() { + return (Math.floor((Math.random() * 5)) + 1); +} +} + +// unique-values +function run_unique_values() { +function uniqueValues(xs) { + return Array.from(new Set(xs)); +} +} + +// falsey-values +function run_falsey_values() { +function falseyValues() { + return [false, 0, "", null, undefined, NaN]; +} +} + +// currying +function run_currying() { +function add(x) { + return function(y) { + return (x + y); + }; +} +} + +// object-destructuring +function run_object_destructuring() { +function describePerson(person) { + return (() => { + const { name: name, age: age = 0 } = person; + return (name + ":" + String(age)); + })(); +} +} + +// timer-interval +function run_timer_interval() { +function startTimer() { + { + let ticks = 0; + let intervalId = false; + intervalId = setInterval(function() { + ticks = (ticks + 1); + if ((ticks === 3)) { + clearInterval(intervalId); + } + return undefined; + }, 10); + return {id: intervalId, getTicks: function() { + return ticks; + }}; + } +} +} + +// object-props +function run_object_props() { +function objectProps() { + { + let obj = {a: 1}; + let a1 = obj.a; + let a2 = obj["a"]; + return (() => { + const { a: a3 } = obj; + obj.b = 2; + obj["c"] = 3; + delete obj["a"]; + return [a1, a2, a3, obj.b, obj["c"], Object.hasOwn(obj, "a")]; + })(); + } +} +} + +// string-concat-order +function run_string_concat_order() { +function concatOrder() { + return [(1 + 2 + "3"), ("1" + 2 + 3)]; +} +} + +// freeze-vs-seal +function run_freeze_vs_seal() { +function freezeVsSeal() { + { + let frozen = Object.freeze({a: 1}); + let sealed = Object.seal({a: 1}); + frozen.a = 9; + sealed.a = 9; + delete sealed["a"]; + return [frozen.a, sealed.a, Object.isFrozen(frozen), Object.isSealed(sealed), Object.hasOwn(sealed, "a")]; + } +} +} + +// switch +function run_switch() { +function switchExample(n) { + return (() => { + { + const __case_value = n; + switch (__case_value) { + case 1: + return "one"; + break; + case 2: + case 3: + return "two-or-three"; + break; + default: + return "other"; + } + } + })(); +} +} + +// class-constructor +function run_class_constructor() { +class Greeter { + constructor(name = "world") { + this.name = name; + } + greet() { + return ("Hello " + this.name); + } +} +function classExample() { + { + let a = new Greeter(); + let b = new Greeter("Ada"); + return [a.greet(), b.greet()]; + } +} +} + +// sort-objects-by-property +function run_sort_objects_by_property() { +function sortByProperty(xs, prop) { + return xs.slice().sort(function(a, b) { + return (a[prop] - b[prop]); + }); +} +} + +// delete-array-elements +function run_delete_array_elements() { +function deleteArrayWays(xs) { + { + let a1 = xs.slice(); + let a2 = xs.slice(); + let a3 = xs.slice(); + let a4 = xs.slice(); + a1.splice(1, 1); + a2 = a2.filter(function(x, i) { + return ((i === 1) === false); + }); + a3 = a3.slice(0, 1).concat(a3.slice(2)); + delete a4[1]; + return [a1, a2, a3, [Object.hasOwn(a4, "1"), (a4).length]]; + } +} +} + +// bubble-sort +function run_bubble_sort() { +function bubbleSort(xs) { + { + let a = xs.slice(); + let n = (a).length; + while (n > 1) { + { + let i = 1; + while (i < n) { + if ((() => { + const __cmp_1 = (a)[(i - 1)]; + const __cmp_2 = (a)[i]; + return (__cmp_1 > __cmp_2); + })()) { + { + let tmp = (a)[(i - 1)]; + a[(i - 1)] = (a)[i]; + a[i] = tmp; + } + } + i = (i + 1); + } + } + n = (n - 1); + } + return a; + } +} +} + +// binary-search +function run_binary_search() { +function binarySearch(xs, target, low, high) { + if (low > high) { + return -1; + } else { + { + let mid = Math.floor((() => { + const __div_3 = (low + high); + const __div_4 = 2; + if (__div_4 === 0) throw new Error("division by zero"); + return (__div_3 / __div_4); + })()); + let value = (xs)[mid]; + const __cond_value_5 = (value === target); + if (__cond_value_5 !== false) { + return mid; + } else { + const __cond_value_6 = (value < target); + if (__cond_value_6 !== false) { + return binarySearch(xs, target, (mid + 1), high); + } else { + return binarySearch(xs, target, low, (mid - 1)); + } + } + } + } +} +} + +// map-count-occurrences +function run_map_count_occurrences() { +function countOccurrences(xs) { + { + let counts = new Map(); + for (const x of xs) { + if ((counts.has(x) !== false)) { + counts.set(x, (counts.get(x) + 1)); + } else { + counts.set(x, 1); + } + } + return Array.from(counts.entries()); + } +} +} + +// get-html-three-ways +function run_get_html_three_ways() { +function getHtmlThreeWays() { + return [document.body.innerHTML, document.querySelector("body").innerHTML, document.getElementById("root")["innerHTML"]]; +} +} + +// anagram +function run_anagram() { +function sortChars(s) { + return s.split("").sort().join(""); +} +function canArrange(stringA, stringB) { + return (() => { + const __cmp_8 = sortChars(stringA); + const __cmp_9 = sortChars(stringB); + return (__cmp_8 === __cmp_9); + })(); +} +} + +// pairs-equal-target +function run_pairs_equal_target() { +function pairsEqualTarget(xs, target) { + { + let seen = new Set(); + let used = new Set(); + let out = []; + for (const x of xs) { + { + let y = (target - x); + if (((() => { + let __and_value_11 = seen.has(y); + if (__and_value_11 === false) return false; + __and_value_11 = (used.has(x) === false); + if (__and_value_11 === false) return false; + return (used.has(y) === false); + })() !== false)) { + out.push([y, x]); + used.add(x); + used.add(y); + } else { + seen.add(x); + } + } + } + return out; + } +} +} + +// fetch-api +function run_fetch_api() { +function loadTitle(url) { + return fetch(url).then(function(response) { + return response.json(); + }).then(function(data) { + return {ok: true, title: data.title}; + }).catch(function(err) { + return {ok: false, message: err.message}; + }); +} +} diff --git a/demo/js-usecases.rkt b/demo/js-usecases.rkt new file mode 100644 index 0000000..a3a2c55 --- /dev/null +++ b/demo/js-usecases.rkt @@ -0,0 +1,304 @@ +#lang racket/base + +(require racket/list + "../main.rkt") + +(provide usecase-random-number + usecase-unique-values + usecase-falsey-values + usecase-currying + usecase-object-destructuring + usecase-timer-interval + usecase-object-props + usecase-string-concat-order + usecase-freeze-vs-seal + usecase-switch + usecase-class-constructor + usecase-sort-objects-by-property + usecase-delete-array-elements + usecase-bubble-sort + usecase-binary-search + usecase-map-count-occurrences + usecase-get-html-three-ways + usecase-anagram + usecase-pairs-equal-target + usecase-fetch-api + all-js-usecases + show-js-usecases + write-js-usecases-file) + +;; Use case 01: generate a random integer between 1 and 5. +(define usecase-random-number + (js + (define (randomBetween1And5) + (return (+ (send Math floor (* (send Math random) 5)) 1))))) + +;; Use case 02: get unique values from an array with duplicates using Set. +(define usecase-unique-values + (js + (define (uniqueValues xs) + (return (send Array from (new Set xs)))))) + +;; Use case 03: the six JavaScript falsey values. +(define usecase-falsey-values + (js + (define (falseyValues) + (return (array #f 0 "" js-null js-undefined js-NaN))))) + +;; Use case 04: currying, simple example. +(define usecase-currying + (js + (define (add x) + (return (lambda (y) + (return (+ x y))))))) + +;; Use case 05: object destructuring. +(define usecase-object-destructuring + (js + (define (describePerson person) + (let-object ([name 'name] + [age 'age 0]) + person + (return (string-append name ":" (number->string age))))))) + +;; Use case 06: get out of a timer interval with setInterval/clearInterval. +(define usecase-timer-interval + (js + (define (startTimer) + (let* ([ticks 0] + [intervalId #f]) + (set! intervalId + (setInterval (lambda () + (set! ticks (+ ticks 1)) + (when (= ticks 3) + (clearInterval intervalId))) + 10)) + (return (object 'id intervalId + 'getTicks (lambda () (return ticks)))))))) + +;; Use case 07: get/set/delete object properties. The value of a is read via +;; dot access, bracket access, and destructuring. +(define usecase-object-props + (js + (define (objectProps) + (let* ([obj (object 'a 1)] + [a1 obj.a] + [a2 (js-ref obj "a")]) + (let-object ([a3 'a]) obj + (set! obj.b 2) + (set-prop! obj "c" 3) + (delete-prop! obj "a") + (return (array a1 a2 a3 obj.b (js-ref obj "c") + (send Object hasOwn obj "a")))))))) + +;; Use case 08: string concatenation; order matters with JavaScript +. +(define usecase-string-concat-order + (js + (define (concatOrder) + (return (array (+ 1 2 "3") + (+ "1" 2 3)))))) + +;; Use case 09: Object.freeze() vs Object.seal(). +(define usecase-freeze-vs-seal + (js + (define (freezeVsSeal) + (let* ([frozen (send Object freeze (object 'a 1))] + [sealed (send Object seal (object 'a 1))]) + (set! frozen.a 9) + (set! sealed.a 9) + (delete-prop! sealed "a") + (return (array frozen.a + sealed.a + (send Object isFrozen frozen) + (send Object isSealed sealed) + (send Object hasOwn sealed "a"))))))) + +;; Use case 10: switch example. The Racket surface form is case. +(define usecase-switch + (js + (define (switchExample n) + (case n + [(1) (return "one")] + [(2 3) (return "two-or-three")] + [else (return "other")])))) + +;; Use case 11: class constructor with a default value. +(define usecase-class-constructor + (js + (define-class Greeter + (constructor ([name "world"]) + (set! this.name name)) + (method greet () + (return (string-append "Hello " this.name)))) + + (define (classExample) + (let* ([a (new Greeter)] + [b (new Greeter "Ada")]) + (return (array (send a greet) (send b greet))))))) + +;; Use case 12: sort an array of objects by a given property. +(define usecase-sort-objects-by-property + (js + (define (sortByProperty xs prop) + (return (send (send xs slice) + sort + (lambda (a b) + (return (- (js-ref a prop) (js-ref b prop))))))))) + +;; Use case 13: four ways to delete/remove an element from an array. +(define usecase-delete-array-elements + (js + (define (deleteArrayWays xs) + (let* ([a1 (send xs slice)] + [a2 (send xs slice)] + [a3 (send xs slice)] + [a4 (send xs slice)]) + ;; 1. Mutating removal with splice. + (send a1 splice 1 1) + ;; 2. Functional removal with filter. + (set! a2 (send a2 filter (lambda (x i) (return (not (= i 1)))))) + ;; 3. Rebuild with slice + concat. + (set! a3 (send (send a3 slice 0 1) concat (send a3 slice 2))) + ;; 4. delete leaves a hole and preserves length. + (delete-prop! a4 1) + (return (array a1 a2 a3 (array (send Object hasOwn a4 "1") (length a4)))))))) + +;; Use case 14: Bubble Sort. +(define usecase-bubble-sort + (js + (define (bubbleSort xs) + (let* ([a (send xs slice)] + [n (length a)]) + (while (> n 1) + (let* ([i 1]) + (while (< i n) + (when (> (list-ref a (- i 1)) (list-ref a i)) + (let* ([tmp (list-ref a (- i 1))]) + (vector-set! a (- i 1) (list-ref a i)) + (vector-set! a i tmp))) + (set! i (+ i 1)))) + (set! n (- n 1))) + (return a))))) + +;; Use case 15: Binary Search using recursion. +(define usecase-binary-search + (js + (define (binarySearch xs target low high) + (if (> low high) + (return -1) + (let* ([mid (send Math floor (/ (+ low high) 2))] + [value (list-ref xs mid)]) + (cond + [(= value target) (return mid)] + [(< value target) (return (binarySearch xs target (+ mid 1) high))] + [else (return (binarySearch xs target low (- mid 1)))])))))) + +;; Use case 16: use Map to count how often each element occurs in an array. +(define usecase-map-count-occurrences + (js + (define (countOccurrences xs) + (let* ([counts (new Map)]) + (for ([x (in-list xs)]) + (if (send counts has x) + (send counts set x (+ (send counts get x) 1)) + (send counts set x 1))) + (return (send Array from (send counts entries))))))) + +;; Use case 17: get HTML in three different ways via the DOM. +(define usecase-get-html-three-ways + (js + (define (getHtmlThreeWays) + (return (array document.body.innerHTML + (js-dot (send document querySelector "body") innerHTML) + (js-ref (send document getElementById "root") "innerHTML")))))) + +;; Use case 18: determine if stringA can be arranged into stringB. +(define usecase-anagram + (js + (define (sortChars s) + (return (send (send (send s split "") sort) join ""))) + + (define (canArrange stringA stringB) + (return (string=? (sortChars stringA) (sortChars stringB)))))) + +;; Use case 19: determine what pairs in an array equal a given value, with no +;; repeated numbers in the result pairs. +(define usecase-pairs-equal-target + (js + (define (pairsEqualTarget xs target) + (let* ([seen (new Set)] + [used (new Set)] + [out (array)]) + (for ([x (in-list xs)]) + (let* ([y (- target x)]) + (if (and (send seen has y) + (not (send used has x)) + (not (send used has y))) + (begin + (send out push (array y x)) + (send used add x) + (send used add y)) + (send seen add x)))) + (return out))))) + +;; Use case 20: fetch API, handling results and errors. The function returns a +;; Promise, which the test framework awaits. +(define usecase-fetch-api + (js + (define (loadTitle url) + (return + (send + (send + (send (fetch url) + then + (lambda (response) + (return (send response json)))) + then + (lambda (data) + (return (object 'ok #t 'title data.title)))) + catch + (lambda (err) + (return (object 'ok #f 'message err.message)))))))) + +(define all-js-usecases + `((random-number . ,usecase-random-number) + (unique-values . ,usecase-unique-values) + (falsey-values . ,usecase-falsey-values) + (currying . ,usecase-currying) + (object-destructuring . ,usecase-object-destructuring) + (timer-interval . ,usecase-timer-interval) + (object-props . ,usecase-object-props) + (string-concat-order . ,usecase-string-concat-order) + (freeze-vs-seal . ,usecase-freeze-vs-seal) + (switch . ,usecase-switch) + (class-constructor . ,usecase-class-constructor) + (sort-objects-by-property . ,usecase-sort-objects-by-property) + (delete-array-elements . ,usecase-delete-array-elements) + (bubble-sort . ,usecase-bubble-sort) + (binary-search . ,usecase-binary-search) + (map-count-occurrences . ,usecase-map-count-occurrences) + (get-html-three-ways . ,usecase-get-html-three-ways) + (anagram . ,usecase-anagram) + (pairs-equal-target . ,usecase-pairs-equal-target) + (fetch-api . ,usecase-fetch-api))) + +(define (show-js-usecases) + (for ([entry (in-list all-js-usecases)]) + (displayln (format "// ~a" (car entry))) + (displayln (cdr entry)) + (newline))) + +(define (write-js-usecases-file path) + (call-with-output-file path + #:exists 'replace + (lambda (out) + (displayln "// Generated by demo/js-usecases.rkt" out) + (displayln "// Each use case is wrapped in a function so snippets with return are valid." out) + (for ([entry (in-list all-js-usecases)]) + (fprintf out "\n// ~a\n" (car entry)) + (fprintf out "function run_~a() {\n~a\n}\n" + (regexp-replace* #rx"[^A-Za-z0-9_$]" (symbol->string (car entry)) "_") + (cdr entry)))))) + +(module+ main + (show-js-usecases)) diff --git a/demo/show-jsmaker-output.rkt b/demo/show-jsmaker-output.rkt new file mode 100644 index 0000000..3c698f7 --- /dev/null +++ b/demo/show-jsmaker-output.rkt @@ -0,0 +1,32 @@ +#lang racket/base +(require "../main.rkt") + +(define examples + (list + (cons 'expression + (js/expression + (let loop ([i 0] [acc 0]) + (if (< i 5) + (loop (+ i 1) (+ acc i)) + acc)))) + (cons 'program-t1 + (js + (set! window.myfunc + (位 (x) + (let* ((el (send document getElementById 'hi)) + (y (* x x))) + (send el setAttribute "x" (+ y ""))) + (send console log "dit set attribute x on element hi"))))) + (cons 'program-t2 + (js + (define (f x) + (if (and (> x 10) (< x 15)) + (begin (console.log x) + (return x)) + (return (* x x)))))) + (cons 'regexp + (js/expression + (regexp-match #px"([a-z]+)-([0-9]+)" "abc-123"))))) + +(for ([e (in-list examples)]) + (printf "===== ~a =====\n~a\n\n" (car e) (cdr e))) diff --git a/demo/show-optimized.rkt b/demo/show-optimized.rkt new file mode 100644 index 0000000..3963683 --- /dev/null +++ b/demo/show-optimized.rkt @@ -0,0 +1,16 @@ +#lang racket/base +(require "../main.rkt") +(displayln "--- and ---") +(displayln (js/expression (and (> x 10) (< x 15)))) +(displayln "--- t2 ---") +(displayln (js (define (f x) + (if (and (> x 10) (< x 15)) + (begin (console.log x) + (return x)) + (return (* x x)))))) +(displayln "--- let* ---") +(displayln (js (let* ((x 10) + (y (+ x x))) + (return y)))) +(displayln "--- let* tdz ---") +(displayln (js/expression (let ([x 4]) (let* ([x x] [y x]) (+ x y))))) diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..86eb24c --- /dev/null +++ b/info.rkt @@ -0,0 +1,41 @@ +#lang info + +(define collection "jsmaker") +(define version "0.2") +(define pkg-desc "Syntax-driven Racket-to-JavaScript maker macro with regression tests.") +(define pkg-authors '(hans-dijkema)) +(define deps '("base")) +(define build-deps '("scribble-lib" "racket-doc")) + +(define scribblings + '(("scrbl/jsmaker.scrbl" () (library)) + ("scrbl/usecases.scrbl" () (library)))) + +;; Running the package test suite should invoke exactly the maintained +;; regression entry point. The regression framework itself skips JavaScript +;; execution with warnings when no JavaScript engine is available, unless +;; JSMAKER_REQUIRE_ENGINE or JSMAKER_REQUIRE_NODE is set. +(define test-include-paths '("testing/jsmaker-regressions.rkt")) + +;; These files are supporting/reference files in this package layout and are +;; not part of the package test entry point. +(define test-omit-paths + '("private/utils.rkt" + "private/syntax-helpers.rkt" + "demo/show-jsmaker-output.rkt" + "demo/show-optimized.rkt" + "testing/jsmaker-executors.rkt" + "testing/jsmaker-test-framework.rkt" + "testing/jsmaker-test-runner.rkt" + "testing/jsmaker-regression.rkt" + "testing/jsmaker-regexp-regression.rkt" + "testing/jsmaker-program-regression.rkt" + "testing/jsmaker-dom-exercises.rkt" + "testing/jsmaker-usecases.rkt")) + +;; The private files are compatibility/support material and have project-local +;; dependencies in downstream copies. The public module and tests do not +;; depend on them. +(define compile-omit-paths + '("private/utils.rkt" + "private/syntax-helpers.rkt")) diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..619b462 --- /dev/null +++ b/main.rkt @@ -0,0 +1,1185 @@ +#lang racket/base + +(require (for-syntax racket/base + racket/list + racket/match + racket/string)) + +(provide js js/expression) + +;; The js macro translates a practical Racket-expression subset to JavaScript. +;; It is intentionally syntax-driven: the Racket expressions are not evaluated. + +(begin-for-syntax + (struct unsupported (message datum) #:transparent) + + (define (fail who d) + (raise-syntax-error 'js (format "unsupported ~a: ~v" who d))) + + (define (indent s [prefix " "]) + (define lines (string-split s "\n" #:trim? #f)) + (string-join (map (位 (line) (if (string=? line "") line (string-append prefix line))) lines) "\n")) + + (define (join-lines xs) + (string-join (filter (位 (x) (and x (not (string=? x "")))) xs) "\n")) + + (define (escape-js-string s) + (define out (open-output-string)) + (for ([ch (in-string s)]) + (case ch + [(#\\) (display "\\\\" out)] + [(#\") (display "\\\"" out)] + [(#\newline) (display "\\n" out)] + [(#\return) (display "\\r" out)] + [(#\tab) (display "\\t" out)] + [else (display ch out)])) + (get-output-string out)) + + (define (js-string s) (format "\"~a\"" (escape-js-string s))) + + (define reserved-js + '(break case catch class const continue debugger default delete do else export extends + finally for function if import in instanceof let new return super switch this throw + try typeof var void while with yield enum await implements package protected static + interface private public null true false undefined NaN Infinity)) + + (define (replace-suffix s suffix replacement) + (if (string-suffix? s suffix) + (string-append (substring s 0 (- (string-length s) (string-length suffix))) replacement) + s)) + + (define (id->js x) + (define s0 (cond [(symbol? x) (symbol->string x)] [(keyword? x) (keyword->string x)] [else (format "~a" x)])) + (cond + [(member s0 '("...")) (fail "identifier" x)] + [(regexp-match? #rx"^[A-Za-z_$][A-Za-z0-9_$]*(\\.[A-Za-z_$][A-Za-z0-9_$]*)*$" s0) + (if (memq (string->symbol s0) reserved-js) (string-append s0 "_") s0)] + [else + (define parts (string-split s0 "." #:trim? #f)) + (define (clean part) + (define p1 (replace-suffix (replace-suffix (replace-suffix part "?" "_p") "!" "_bang") "->" "_to")) + (define p2 (regexp-replace* #rx"[^A-Za-z0-9_$]" p1 "_")) + (define p3 (if (regexp-match? #rx"^[A-Za-z_$]" p2) p2 (string-append "_" p2))) + (if (memq (string->symbol p3) reserved-js) (string-append p3 "_") p3)) + (string-join (map clean parts) ".")])) + + (define (prop->js x) + ;; Property names after a dot may legally be reserved words in modern + ;; JavaScript, for example promise.catch(...). Variable identifiers still + ;; use id->js, but method/property positions use this less restrictive + ;; mapper. + (define s0 (cond [(symbol? x) (symbol->string x)] [(keyword? x) (keyword->string x)] [else (format "~a" x)])) + (define s1 (replace-suffix (replace-suffix (replace-suffix s0 "?" "_p") "!" "_bang") "->" "_to")) + (define s2 (regexp-replace* #rx"[^A-Za-z0-9_$]" s1 "_")) + (if (regexp-match? #rx"^[A-Za-z_$]" s2) s2 (string-append "_" s2))) + + (define (compile-assignment-target target) + (match target + [(? symbol?) (id->js target)] + [(list 'js-ref obj key) (format "~a[~a]" (compile-expr obj) (compile-expr key))] + [(list 'js-dot obj (? symbol? key)) (format "~a.~a" (compile-expr obj) (prop->js key))] + [_ (fail "assignment target" target)])) + + (define (compile-delete-target obj key) + (format "delete ~a[~a]" (compile-expr obj) (compile-expr key))) + + (define (object-binding-prop->js prop) + (match prop + [(list 'quote (? symbol? s)) (prop->js s)] + [(? symbol? s) (prop->js s)] + [(? keyword? kw) (prop->js kw)] + [(? string? s) s] + [_ (fail "object destructuring property" prop)])) + + (define (compile-object-destructure-pattern bindings) + (define parts + (for/list ([b (in-list bindings)]) + (match b + [(list id prop) + (format "~a: ~a" (object-binding-prop->js prop) (id->js id))] + [(list id prop default) + (format "~a: ~a = ~a" (object-binding-prop->js prop) (id->js id) (compile-expr default))] + [_ (fail "object destructuring binding" b)]))) + (format "{ ~a }" (string-join parts ", "))) + + (define (compile-let-object bindings obj body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f]) + (define content + (join-lines + (list (format "const ~a = ~a;" (compile-object-destructure-pattern bindings) (compile-expr obj)) + (compile-body body #:return-last? return-last?)))) + (if as-expression? + (format "(() => ~a)()" (block content)) + (block content))) + + (define (compile-class-member m) + (match m + [(list 'constructor formals body ...) #:when (not (and (list? formals) (andmap list? formals))) + (format "constructor(~a) ~a" (compile-formals formals) (block (compile-body body)))] + [(list 'constructor bindings body ...) #:when (and (list? bindings) (andmap list? bindings)) + (define formals + (string-join + (for/list ([b (in-list bindings)]) + (match b + [(list id default) (format "~a = ~a" (id->js id) (compile-expr default))] + [(list id) (id->js id)] + [_ (fail "constructor binding" b)])) + ", ")) + (format "constructor(~a) ~a" formals (block (compile-body body)))] + [(list 'method (? symbol? name) formals body ...) + (format "~a(~a) ~a" (prop->js name) (compile-formals formals) (block (compile-body body #:return-last? #t)))] + [_ (fail "class member" m)])) + + (define (compile-define-class name members) + (format "class ~a { +~a +}" + (id->js name) + (indent (string-join (map compile-class-member members) " +")))) + + + (define (unsupported-regexp-reason src) + ;; JavaScript RegExp is close to Racket #px for common cases, but it is + ;; not PCRE/Racket. Reject known constructs that would silently change + ;; meaning or fail cryptically in JavaScript. This is deliberately a + ;; conservative syntax check, not a full regexp parser. + (cond + [(regexp-match? #rx"\\(\\?[imsxU-]" src) + "inline regexp option groups such as (?i:...) are not translated to JavaScript flags"] + [(regexp-match? #rx"\\(\\?>" src) + "atomic groups (?>...) are not supported by JavaScript RegExp"] + [(regexp-match? #rx"\\(\\?\\(" src) + "conditional regexp groups are not supported by JavaScript RegExp"] + [(regexp-match? #rx"\\(\\?P" src) + "Python/PCRE-style named groups (?P...) are not supported by JavaScript RegExp"] + [(regexp-match? #rx"\\\\[pP]\\{" src) + "Unicode property escapes are not emitted yet; JavaScript requires careful u-flag handling"] + [else #f])) + + (define (compile-regexp-literal rx) + (cond + [(or (byte-regexp? rx) (byte-pregexp? rx)) + (fail "byte regexp literal" rx)] + [else + (define src (object-name rx)) + (define reason (unsupported-regexp-reason src)) + (when reason (fail reason rx)) + (format "new RegExp(~a)" (js-string src))])) + + (define (literal->js v) + (cond + [(void? v) "undefined"] + [(eq? v #t) "true"] + [(eq? v #f) "false"] + [(regexp? v) (compile-regexp-literal v)] + [(or (byte-regexp? v) (byte-pregexp? v)) (fail "byte regexp literal" v)] + [(number? v) (number->string v)] + [(string? v) (js-string v)] + [(char? v) (js-string (string v))] + [(symbol? v) (js-string (symbol->string v))] + [(keyword? v) (js-string (keyword->string v))] + [(null? v) "[]"] + [(pair? v) (format "[~a]" (string-join (map literal->js v) ", "))] + [(vector? v) (format "[~a]" (string-join (map literal->js (vector->list v)) ", "))] + [else (fail "literal" v)])) + + (define (block stmt) + (string-append "{\n" (indent stmt) "\n}")) + + (define (parens s) (string-append "(" s ")")) + + (define (strip-one-outer-parens s) + (if (and (positive? (string-length s)) + (char=? (string-ref s 0) #\() + (char=? (string-ref s (sub1 (string-length s))) #\))) + (substring s 1 (sub1 (string-length s))) + s)) + + (define tmp-counter 0) + + (define (fresh prefix) + (set! tmp-counter (add1 tmp-counter)) + (format "__~a_~a" prefix tmp-counter)) + + ;; Racket conditionals treat only #f as false. JavaScript would also + ;; reject 0, "", null and undefined in condition position, so every + ;; Racket test is compiled through this helper. + (define (compile-test d) + (if (boolean-expr? d) + (let ([e (compile-expr d)]) + ;; Keep IIFEs intact: (() => {...})() starts and ends with parens, + ;; but removing the first/last character makes invalid JavaScript. + (if (regexp-match? #rx"=>" e) e (strip-one-outer-parens e))) + (format "(~a !== false)" (compile-expr d)))) + + (define (compile-arg-list args) + (string-join (map id->js args) ", ")) + + (define (split-formals formals) + (cond + [(null? formals) (values '() #f)] + [(symbol? formals) (values '() formals)] + [(pair? formals) + (let loop ([xs formals] [acc '()]) + (cond + [(null? xs) (values (reverse acc) #f)] + [(symbol? xs) (values (reverse acc) xs)] + [(pair? xs) (loop (cdr xs) (cons (car xs) acc))] + [else (fail "formals" formals)]))] + [else (fail "formals" formals)])) + + (define (compile-formals formals) + (define-values (pos rest) (split-formals formals)) + (define pos-js (map id->js pos)) + (define all-js (if rest (append pos-js (list (string-append "..." (id->js rest)))) pos-js)) + (string-join all-js ", ")) + + (define (binding-id b) + (match b + [(list id _) id] + [(list id _ ...) id] + [_ (fail "binding" b)])) + + (define (binding-rhs b) + (match b + [(list _ rhs) rhs] + [_ (fail "binding" b)])) + + (define (binding-ids b) + (match b + [(list ids _) ids] + [_ (fail "value binding" b)])) + + (define (ids-pattern->js ids) + (cond + [(and (list? ids) (= (length ids) 1)) (id->js (car ids))] + [(list? ids) (format "[~a]" (compile-arg-list ids))] + [(symbol? ids) (id->js ids)] + [else (fail "binding ids" ids)])) + + (define (definition? d) + (match d + [(list 'define _ ...) #t] + [(list 'define-values _ ...) #t] + [_ #f])) + + (define (return-form? d) + (match d + [(list 'return _) #t] + [_ #f])) + + (define (compile-body body #:return-last? [return-last? #f]) + (cond + [(null? body) (if return-last? "return undefined;" "")] + [else + (define n (length body)) + (join-lines + (for/list ([form (in-list body)] [i (in-naturals)]) + (define last? (= i (sub1 n))) + (if (and return-last? last? (not (definition? form))) + (compile-return form) + (compile-stmt form))))])) + + (define (compile-return d) + (match d + [(list 'return) "return undefined;"] + [(list 'return e) (format "return ~a;" (compile-expr e))] + [(list 'begin es ...) + (compile-body es #:return-last? #t)] + [(list 'if c t e) + (format "if (~a) ~a else ~a" (compile-test c) + (block (compile-body (list t) #:return-last? #t)) + (block (compile-body (list e) #:return-last? #t)))] + [(list 'cond clauses ...) + (compile-cond clauses #:return-last? #t)] + [(list 'with-handlers clauses body ...) + (compile-with-handlers clauses body #:return-last? #t #:as-expression? #f)] + [(list 'let name bindings body ...) #:when (symbol? name) + (compile-named-let name bindings body #:return-last? #t #:as-expression? #f)] + [(list 'let bindings body ...) + (compile-let 'let bindings body #:return-last? #t #:as-expression? #f)] + [(list 'let* bindings body ...) + (compile-let 'let* bindings body #:return-last? #t #:as-expression? #f)] + [(list 'letrec bindings body ...) + (compile-let 'letrec bindings body #:return-last? #t #:as-expression? #f)] + [(list 'let-values bindings body ...) + (compile-let-values 'let-values bindings body #:return-last? #t #:as-expression? #f)] + [(list 'let*-values bindings body ...) + (compile-let-values 'let*-values bindings body #:return-last? #t #:as-expression? #f)] + [(list 'when c body ...) + (format "if (~a) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))] + [(list 'unless c body ...) + (format "if (!(~a)) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))] + [_ (format "return ~a;" (compile-expr d))])) + + (define (compile-stmt d) + (match d + [(list 'begin es ...) + (compile-body es)] + [(list 'begin0 first rest ...) + (join-lines (cons (compile-stmt first) (map compile-stmt rest)))] + [(list 'define (? pair? sig) body ...) + (format "function ~a(~a) ~a" (id->js (car sig)) (compile-formals (cdr sig)) (block (compile-body body #:return-last? #t)))] + [(list 'define id rhs) + (format "let ~a = ~a;" (id->js id) (compile-expr rhs))] + [(list 'define-values (list id) rhs) + (format "let ~a = ~a;" (id->js id) (compile-expr rhs))] + [(list 'define-values ids rhs) + (format "let [~a] = ~a;" (compile-arg-list ids) (compile-expr rhs))] + [(list 'set! target rhs) + (format "~a = ~a;" (compile-assignment-target target) (compile-expr rhs))] + [(list 'return) + "return undefined;"] + [(list 'return e) + (format "return ~a;" (compile-expr e))] + [(list 'while c body ...) + (format "while (~a) ~a" (compile-test c) (block (compile-body body)))] + [(list 'if c t e) + (format "if (~a) ~a else ~a" (compile-test c) (block (compile-body (list t))) (block (compile-body (list e))))] + [(list 'cond clauses ...) + (compile-cond clauses #:return-last? #f)] + [(list 'with-handlers clauses body ...) + (compile-with-handlers clauses body #:return-last? #f #:as-expression? #f)] + [(list 'case key clauses ...) + (compile-case key clauses #:return-last? #f)] + [(list 'when c body ...) + (format "if (~a) ~a" (compile-test c) (block (compile-body body)))] + [(list 'unless c body ...) + (format "if (!(~a)) ~a" (compile-test c) (block (compile-body body)))] + [(list 'let name bindings body ...) #:when (symbol? name) + (compile-named-let name bindings body #:return-last? #f #:as-expression? #f)] + [(list 'let bindings body ...) + (compile-let 'let bindings body #:return-last? #f #:as-expression? #f)] + [(list 'let* bindings body ...) + (compile-let 'let* bindings body #:return-last? #f #:as-expression? #f)] + [(list 'letrec bindings body ...) + (compile-let 'letrec bindings body #:return-last? #f #:as-expression? #f)] + [(list 'let-values bindings body ...) + (compile-let-values 'let-values bindings body #:return-last? #f #:as-expression? #f)] + [(list 'let*-values bindings body ...) + (compile-let-values 'let*-values bindings body #:return-last? #f #:as-expression? #f)] + [(list 'for clauses body ...) + (compile-for clauses body #:collect? #f #:as-expression? #f)] + [(list 'for/list clauses body ...) + (format "~a;" (compile-for clauses body #:collect? #t #:as-expression? #t))] + [(list 'for/vector clauses body ...) + (format "~a;" (compile-for clauses body #:collect? #t #:as-expression? #t))] + [(list 'vector-set! v i val) + (format "~a[~a] = ~a;" (compile-expr v) (compile-expr i) (compile-expr val))] + [(list 'set-prop! obj key val) + (format "~a[~a] = ~a;" (compile-expr obj) (compile-expr key) (compile-expr val))] + [(list 'delete-prop! obj key) + (format "~a;" (compile-delete-target obj key))] + [(list 'let-object bindings obj body ...) + (compile-let-object bindings obj body #:return-last? #f #:as-expression? #f)] + [(list 'define-class name members ...) + (compile-define-class name members)] + [(list 'send obj method args ...) + (format "~a.~a(~a);" (compile-expr obj) (prop->js method) (string-join (map compile-expr args) ", "))] + [_ + (format "~a;" (compile-expr d))])) + + (define (compile-let kind bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f]) + (define (body-code) (compile-body body #:return-last? return-last?)) + (define content + (case kind + [(let) + ;; Evaluate all RHS expressions before introducing the JS let bindings. + ;; This avoids JavaScript TDZ bugs for Racket code such as + ;; (let ([x x]) ...), where the RHS must see the outer x. + (define tmps (for/list ([_ (in-list bindings)]) (fresh "let_value"))) + (define rhs-stmts + (for/list ([tmp (in-list tmps)] [b (in-list bindings)]) + (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b))))) + (define bind-stmts + (for/list ([tmp (in-list tmps)] [b (in-list bindings)]) + (format "let ~a = ~a;" (id->js (binding-id b)) tmp))) + (join-lines (append rhs-stmts (list (block (join-lines (append bind-stmts (list (body-code))))))))] + [(let*) + ;; Emit the common case directly: + ;; (let* ([x 10] [y (+ x x)]) body) + ;; becomes one JavaScript block with sequential let bindings. Only + ;; when a RHS mentions the same identifier that is being introduced, + ;; such as (let* ([x x]) ...), do we use a temporary to preserve + ;; Racket semantics and avoid JavaScript's temporal-dead-zone error. + (define (mentions-id? x id) + (cond + [(symbol? x) (eq? x id)] + [(pair? x) (or (mentions-id? (car x) id) (mentions-id? (cdr x) id))] + [else #f])) + (define (emit bs) + (cond + [(null? bs) (body-code)] + [else + (define b (car bs)) + (define id (binding-id b)) + (define rhs (binding-rhs b)) + (cond + [(mentions-id? rhs id) + (define tmp (fresh "let_star_value")) + (join-lines + (list (format "const ~a = ~a;" tmp (compile-expr rhs)) + (block (join-lines + (list (format "let ~a = ~a;" (id->js id) tmp) + (emit (cdr bs)))))))] + [else + (join-lines + (list (format "let ~a = ~a;" (id->js id) (compile-expr rhs)) + (emit (cdr bs))))])])) + (emit bindings)] + [(letrec) + (define decls (for/list ([b (in-list bindings)]) (format "let ~a;" (id->js (binding-id b))))) + (define sets (for/list ([b (in-list bindings)]) (format "~a = ~a;" (id->js (binding-id b)) (compile-expr (binding-rhs b))))) + (join-lines (append decls sets (list (body-code))))] + [else (fail "let kind" kind)])) + (if as-expression? + (format "(() => ~a)()" (block content)) + (block content))) + + (define (compile-let-values kind bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f]) + (define (body-code) (compile-body body #:return-last? return-last?)) + (define (bind-stmt ids tmp) (format "let ~a = ~a;" (ids-pattern->js ids) tmp)) + (define content + (case kind + [(let-values) + (define tmps (for/list ([_ (in-list bindings)]) (fresh "let_values"))) + (define rhs-stmts + (for/list ([tmp (in-list tmps)] [b (in-list bindings)]) + (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b))))) + (define bind-stmts + (for/list ([tmp (in-list tmps)] [b (in-list bindings)]) + (bind-stmt (binding-ids b) tmp))) + (join-lines (append rhs-stmts (list (block (join-lines (append bind-stmts (list (body-code))))))))] + [(let*-values) + (define (emit bs) + (cond + [(null? bs) (body-code)] + [else + (define b (car bs)) + (define tmp (fresh "let_star_values")) + (join-lines (list (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b))) + (block (join-lines (list (bind-stmt (binding-ids b) tmp) (emit (cdr bs)))))))])) + (emit bindings)] + [else (fail "let-values kind" kind)])) + (if as-expression? + (format "(() => ~a)()" (block content)) + (block content))) + + (define (compile-named-let name bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f]) + ;; Tail-recursive named let is emitted as a JavaScript loop. This covers + ;; the common Racket idiom: + ;; (let loop ([i 0] [acc 0]) + ;; (if (...) (loop ...) acc)) + ;; without consuming the JavaScript call stack. + (define ids (map binding-id bindings)) + (define vals (map binding-rhs bindings)) + (define loop-name (id->js name)) + (define init-stmts + (for/list ([id (in-list ids)] [v (in-list vals)]) + (format "let ~a = ~a;" (id->js id) (compile-expr v)))) + (define (tail-call? d) + (and (pair? d) (eq? (car d) name))) + (define (emit-tail d) + (match d + [(list 'begin es ...) + (compile-tail-sequence es)] + [(list 'if c t e) + (format "if (~a) ~a else ~a" + (compile-test c) + (block (emit-tail t)) + (block (emit-tail e)))] + [(list 'cond clauses ...) + (compile-cond clauses #:return-last? return-last?)] + [(? tail-call?) + (define args (cdr d)) + (unless (= (length args) (length ids)) + (fail "named let arity" d)) + (define temps (for/list ([_ (in-list args)]) (fresh "loop_arg"))) + (join-lines + (append + (for/list ([tmp (in-list temps)] [arg (in-list args)]) + (format "const ~a = ~a;" tmp (compile-expr arg))) + (for/list ([id (in-list ids)] [tmp (in-list temps)]) + (format "~a = ~a;" (id->js id) tmp)) + (list "continue;")))] + [_ + (if return-last? + (format "return ~a;" (compile-expr d)) + (format "~a; +break;" (compile-expr d)))])) + (define (compile-tail-sequence es) + (cond + [(null? es) (if return-last? "return undefined;" "break;")] + [(null? (cdr es)) (emit-tail (car es))] + [else (join-lines (append (map compile-stmt (reverse (cdr (reverse es)))) + (list (emit-tail (car (reverse es))))))])) + (define content + (join-lines (append init-stmts + (list (format "while (true) ~a" + (block (compile-tail-sequence body))))))) + (if as-expression? + (format "(() => ~a)()" (block content)) + (block content))) + + (define (compile-cond clauses #:return-last? [return-last? #f]) + (define (emit-result expr) + (if return-last? (format "return ~a;" expr) (format "~a;" expr))) + (define (emit-then test-tmp c) + (match c + [(list _ '=> proc) + (emit-result (format "~a(~a)" (compile-callee proc) test-tmp))] + [(list _) + (emit-result test-tmp)] + [(list _ body ...) + (if return-last? (compile-body body #:return-last? #t) (compile-body body))] + [_ (fail "cond clause" c)])) + (define (loop cs) + (cond + [(null? cs) (if return-last? "return undefined;" "")] + [else + (define c (car cs)) + (match c + [(list 'else body ...) + (if return-last? (compile-body body #:return-last? #t) (compile-body body))] + [(list test _ ...) + (define tmp (fresh "cond_value")) + (define else-part (loop (cdr cs))) + (define then-block (block (emit-then tmp c))) + (join-lines + (list (format "const ~a = ~a;" tmp (compile-expr test)) + (if (string=? else-part "") + (format "if (~a !== false) ~a" tmp then-block) + (format "if (~a !== false) ~a else ~a" tmp then-block (block else-part)))))] + [_ (fail "cond clause" c)])])) + (loop clauses)) + + (define (compile-case key clauses #:return-last? [return-last? #f]) + (define key-js (compile-expr key)) + (define tmp "__case_value") + (define (compile-clause c) + (match c + [(list 'else body ...) + (string-append "default:\n" (indent (compile-body body #:return-last? return-last?)))] + [(list datums body ...) + (define tests (for/list ([d (in-list datums)]) (format "case ~a:" (literal->js d)))) + (string-append (string-join tests "\n") "\n" (indent (compile-body body #:return-last? return-last?)) "\n break;")] + [_ (fail "case clause" c)])) + (format "{\n const ~a = ~a;\n switch (~a) {\n~a\n }\n}" + tmp key-js tmp (indent (string-join (map compile-clause clauses) "\n") " "))) + + (define (compile-if-expr c t e) + (format "(~a ? ~a : ~a)" (compile-test c) (compile-expr t) (compile-expr e))) + + (define (compile-begin-expr es) + (format "(() => ~a)()" (block (compile-body es #:return-last? #t)))) + + (define (compile-hash args) + (unless (even? (length args)) (fail "hash expression with odd number of arguments" args)) + (define pairs + (for/list ([k (in-list args)] [v (in-list (cdr args))] [i (in-naturals)] #:when (even? i)) + (define key + (match k + [(list 'quote (? symbol? s)) (symbol->string s)] + [(? keyword? kw) (keyword->string kw)] + [(? symbol? s) (symbol->string s)] + [(? string? s) s] + [_ #f])) + (if key + (format "~a: ~a" (if (regexp-match? #rx"^[A-Za-z_$][A-Za-z0-9_$]*$" key) key (js-string key)) (compile-expr v)) + (format "[~a]: ~a" (compile-expr k) (compile-expr v))))) + (format "{~a}" (string-join pairs ", "))) + + (define (atomic-expr? x) + (or (boolean? x) + (number? x) + (string? x) + (char? x) + (keyword? x) + (regexp? x) + (and (symbol? x) (not (memq x '(#%app quote quasiquote lambda 位 if begin let let* letrec cond case for for/list for/vector for/fold values return while)))) + (and (pair? x) (eq? (car x) 'quote)))) + + (define (boolean-expr? x) + (or (boolean? x) + (and (pair? x) + (let ([op (car x)]) + (or (memq op '(< > <= >= = == equal? eq? eqv? != not-equal? + zero? positive? negative? even? odd? + null? empty? pair? list? vector? number? real? integer? + string? boolean? symbol? regexp? pregexp? regexp-match? + string=? string-ci=? string? string<=? string>=? + hash-has-key? not)) + (and (eq? op 'and) (andmap boolean-expr? (cdr x))) + (and (eq? op 'or) (andmap boolean-expr? (cdr x)))))))) + + (define (compile-pairwise args make-test) + (cond + [(or (null? args) (null? (cdr args))) "true"] + [(andmap atomic-expr? args) + (define compiled (map compile-expr args)) + (define tests + (for/list ([a (in-list compiled)] [b (in-list (cdr compiled))]) + (make-test a b))) + (if (null? (cdr tests)) (car tests) (parens (string-join tests " && ")))] + [else + (define temps (for/list ([_ (in-list args)]) (fresh "cmp"))) + (define bindings + (for/list ([tmp (in-list temps)] [arg (in-list args)]) + (format "const ~a = ~a;" tmp (compile-expr arg)))) + (define tests + (for/list ([a (in-list temps)] [b (in-list (cdr temps))]) + (make-test a b))) + (format "(() => ~a)()" + (block (join-lines (append bindings + (list (format "return ~a;" (string-join tests " && ")))))))])) + + (define (compile-comparison jsop args) + (compile-pairwise args (位 (a b) (format "(~a ~a ~a)" a jsop b)))) + + (define (compile-object-is args) + (compile-pairwise args (位 (a b) (format "Object.is(~a, ~a)" a b)))) + + (define (compile-deep-equal args) + (compile-pairwise + args + (位 (a b) + (format "(Object.is(~a, ~a) || JSON.stringify(~a) === JSON.stringify(~a))" a b a b)))) + + (define (compile-and args) + (cond + [(null? args) "true"] + [(null? (cdr args)) (compile-expr (car args))] + [(andmap boolean-expr? args) + (parens (string-join (map compile-expr args) " && "))] + [else + (define tmp (fresh "and_value")) + (define non-last (reverse (cdr (reverse args)))) + (define last-arg (car (reverse args))) + (define steps + (append + (list (format "let ~a = ~a;" tmp (compile-expr (car non-last))) + (format "if (~a === false) return false;" tmp)) + (for/list ([arg (in-list (cdr non-last))]) + (format "~a = ~a; +if (~a === false) return false;" tmp (compile-expr arg) tmp)) + (list (format "return ~a;" (compile-expr last-arg))))) + (format "(() => ~a)()" (block (join-lines steps)))])) + + (define (compile-or args) + (cond + [(null? args) "false"] + [(andmap boolean-expr? args) + (parens (string-join (map compile-expr args) " || "))] + [else + (define tmp (fresh "or_value")) + (define steps + (for/list ([arg (in-list args)]) + (format "~a = ~a; +if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp))) + (format "(() => ~a)()" + (block (join-lines (append (list (format "let ~a = false;" tmp)) + steps + (list "return false;")))))])) + + (define (compile-sequence d) + (match d + [(list 'in-list xs) (compile-expr xs)] + [(list 'in-vector xs) (compile-expr xs)] + [(list 'in-string xs) (format "Array.from(~a)" (compile-expr xs))] + [(list 'in-range end) + (format "((__end) => { const __out = []; for (let __i = 0; __i < __end; __i++) __out.push(__i); return __out; })(~a)" + (compile-expr end))] + [(list 'in-range start end) + (format "((__start, __end) => { const __out = []; for (let __i = __start; __i < __end; __i++) __out.push(__i); return __out; })(~a, ~a)" + (compile-expr start) (compile-expr end))] + [(list 'in-range start end step) + (format "((__start, __end, __step) => { const __out = []; for (let __i = __start; (__step >= 0 ? __i < __end : __i > __end); __i += __step) __out.push(__i); return __out; })(~a, ~a, ~a)" + (compile-expr start) (compile-expr end) (compile-expr step))] + [_ (compile-expr d)])) + + (define (compile-body-as-expr body) + (cond + [(null? body) "undefined"] + [(null? (cdr body)) (compile-expr (car body))] + [else (compile-begin-expr body)])) + + (define (compile-callee f) + ;; A lambda in callee position must be emitted as a function expression, + ;; not as a function declaration statement. Parenthesizing compound + ;; callees is harmless and prevents invalid code such as: + ;; function(...args) { ... }(__exn) + (define f-js (compile-expr f)) + (if (symbol? f) f-js (parens f-js))) + + (define (compile-for clauses body #:collect? [collect? #f] #:as-expression? [as-expression? #t]) + (define out (fresh "for_out")) + (define (emit clauses*) + (cond + [(null? clauses*) + (if collect? + (format "~a.push(~a);" out (compile-body-as-expr body)) + (compile-body body))] + [else + (define c (car clauses*)) + (cond + [(eq? c '#:when) + (match (cdr clauses*) + [(list test more ...) (format "if (~a) ~a" (compile-test test) (block (emit more)))] + [_ (fail "for #:when clause" clauses*)])] + [(eq? c '#:unless) + (match (cdr clauses*) + [(list test more ...) (format "if (!(~a)) ~a" (compile-test test) (block (emit more)))] + [_ (fail "for #:unless clause" clauses*)])] + [else + (match c + [(list id seq) + (format "for (const ~a of ~a) ~a" (id->js id) (compile-sequence seq) (block (emit (cdr clauses*))))] + [_ (fail "for clause" c)])])])) + (define content + (if collect? + (join-lines (list (format "const ~a = [];" out) (emit clauses) (format "return ~a;" out))) + (emit clauses))) + (cond + [as-expression? (format "(() => ~a)()" (block content))] + [else content])) + + (define (compile-for-fold bindings clauses body) + (define ids (map binding-id bindings)) + (define init-stmts + (for/list ([b (in-list bindings)]) + (format "let ~a = ~a;" (id->js (binding-id b)) (compile-expr (binding-rhs b))))) + (define body-expr (compile-body-as-expr body)) + (define update + (if (= (length ids) 1) + (format "~a = ~a;" (id->js (car ids)) body-expr) + (format "[~a] = ~a;" (compile-arg-list ids) body-expr))) + (define (emit clauses*) + (cond + [(null? clauses*) update] + [else + (define c (car clauses*)) + (cond + [(eq? c '#:when) + (match (cdr clauses*) + [(list test more ...) (format "if (~a) ~a" (compile-test test) (block (emit more)))] + [_ (fail "for/fold #:when clause" clauses*)])] + [(eq? c '#:unless) + (match (cdr clauses*) + [(list test more ...) (format "if (!(~a)) ~a" (compile-test test) (block (emit more)))] + [_ (fail "for/fold #:unless clause" clauses*)])] + [else + (match c + [(list id seq) + (format "for (const ~a of ~a) ~a" (id->js id) (compile-sequence seq) (block (emit (cdr clauses*))))] + [_ (fail "for/fold clause" c)])])])) + (format "(() => ~a)()" + (block (join-lines (append init-stmts + (list (emit clauses) + (if (= (length ids) 1) + (format "return ~a;" (id->js (car ids))) + (format "return [~a];" (compile-arg-list ids))))))))) + + (define (regexp-arg->js pat) + (format "__rkt_to_regexp(~a, false)" (compile-expr pat))) + + (define (regexp-arg->js/global pat) + (format "__rkt_to_regexp(~a, true)" (compile-expr pat))) + + (define (inline-regexp-runtime expr) + (format "((__rkt_body) => {\n const __rkt_to_regexp = (__pat, __global) => {\n const __flags = (__pat instanceof RegExp)\n ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('')\n : (__global ? 'g' : '');\n return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags);\n };\n const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x));\n const __rkt_replacement = (__s) => {\n if (typeof __s !== 'string') return __s;\n let __out = '';\n for (let __i = 0; __i < __s.length; __i++) {\n const __ch = __s[__i];\n if (__ch === '$') { __out += '$$'; continue; }\n if (__ch === '\\\\' && __i + 1 < __s.length) {\n const __n = __s[++__i];\n if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n));\n else __out += __n;\n } else __out += __ch;\n }\n return __out;\n };\n return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement);\n})((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => ~a)" expr)) + + (define (compile-regexp-match args) + (match args + [(list pat s) + (inline-regexp-runtime + (format "__rkt_match_array(String(~a).match(~a))" (compile-expr s) (regexp-arg->js pat)))] + [(list pat s start) + (inline-regexp-runtime + (format "__rkt_match_array(String(~a).slice(~a).match(~a))" + (compile-expr s) (compile-expr start) (regexp-arg->js pat)))] + [_ (fail "regexp-match arity" args)])) + + (define (compile-regexp-match? args) + (match args + [(list pat s) + (inline-regexp-runtime + (format "~a.test(String(~a))" (regexp-arg->js pat) (compile-expr s)))] + [(list pat s start) + (inline-regexp-runtime + (format "~a.test(String(~a).slice(~a))" (regexp-arg->js pat) (compile-expr s) (compile-expr start)))] + [_ (fail "regexp-match? arity" args)])) + + (define (compile-regexp-match* args) + (match args + [(list pat s) + (inline-regexp-runtime + (format "Array.from(String(~a).matchAll(~a), (__m) => __m[0])" + (compile-expr s) (regexp-arg->js/global pat)))] + [(list pat s start) + (inline-regexp-runtime + (format "Array.from(String(~a).slice(~a).matchAll(~a), (__m) => __m[0])" + (compile-expr s) (compile-expr start) (regexp-arg->js/global pat)))] + [_ (fail "regexp-match* arity" args)])) + + (define (compile-regexp-match-positions args) + (match args + [(list pat s) + (inline-regexp-runtime + (format "((__s, __rx) => { const __m = __rx.exec(__s); if (__m === null) return false; return __m.map((__x, __i) => { if (__x === undefined) return false; const __start = __m.indices ? __m.indices[__i][0] : (__i === 0 ? __m.index : __s.indexOf(__x, __m.index)); return [__start, __start + __x.length]; }); })(String(~a), (() => { const __rx = ~a; return new RegExp(__rx.source, Array.from(new Set((__rx.flags.replace(/g/g, '') + 'd').split(''))).join('')); })())" + (compile-expr s) (regexp-arg->js pat)))] + [_ (fail "regexp-match-positions arity" args)])) + + (define (compile-regexp-split args) + (match args + [(list pat s) + (inline-regexp-runtime + (format "String(~a).split(~a)" (compile-expr s) (regexp-arg->js/global pat)))] + [_ (fail "regexp-split arity" args)])) + + (define (compile-regexp-replace args #:all? all?) + (match args + [(list pat s repl) + (inline-regexp-runtime + (format "String(~a).replace(~a, __rkt_replacement(~a))" + (compile-expr s) + ((if all? regexp-arg->js/global regexp-arg->js) pat) + (compile-expr repl)))] + [_ (fail (if all? "regexp-replace* arity" "regexp-replace arity") args)])) + + (define (compile-regexp-quote args) + (match args + [(list s) + (format "String(~a).replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&')" (compile-expr s))] + [_ (fail "regexp-quote arity" args)])) + + + (define (handler-predicate-supported? pred) + ;; Deliberately narrow: js-maker only models one JavaScript catch channel. + ;; It therefore supports generic exn? handlers, not the Racket exception + ;; predicate hierarchy. + (eq? pred 'exn?)) + + (define (compile-with-handlers clauses body #:return-last? [return-last? #t] #:as-expression? [as-expression? #t]) + (unless (and (list? clauses) (andmap list? clauses)) + (fail "with-handlers clauses" clauses)) + (define catch-var (fresh "exn")) + (define (emit-handler cs) + (cond + [(null? cs) (format "throw ~a;" catch-var)] + [else + (match (car cs) + [(list (? symbol? pred) handler) + (unless (handler-predicate-supported? pred) + (fail "with-handlers predicate; only generic exn? is supported" pred)) + (define call (format "~a(~a)" (compile-callee handler) catch-var)) + (if return-last? (format "return ~a;" call) (format "~a;" call))] + [_ (fail "with-handlers clause" (car cs))])])) + (define content + (format "try ~a catch (~a) ~a" + (block (compile-body body #:return-last? return-last?)) + catch-var + (block (emit-handler clauses)))) + (if as-expression? (format "(() => ~a)()" (block content)) content)) + + (define (identifier-local-name op) + ;; Gregor is commonly imported with a prefix, but that prefix is not + ;; stable in user code. This helper strips an arbitrary prefix ending in + ;; ':' and matches on the local binding name. It is intentionally only + ;; used by the small Gregor compatibility table below. + (define s (symbol->string op)) + (define parts (string-split s ":")) + (if (null? parts) s (car (reverse parts)))) + + (define (inline-gregor-runtime expr) + ;; Small JS-side value model for Gregor-like date/time values. Plain dates + ;; and times remain timezone-independent tagged objects. Explicit + ;; ->js-date conversion yields a native JavaScript Date. + (format "((__rkt_body) => {\n const __pad = (__n, __w = 2) => String(__n).padStart(__w, '0');\n const __date = (__y, __m, __d) => ({__gregor: 'date', year: Number(__y), month: Number(__m), day: Number(__d)});\n const __time = (__h, __m, __s = 0) => ({__gregor: 'time', hour: Number(__h), minute: Number(__m), second: Number(__s)});\n const __datetime = (__y, __mo, __d, __h = 0, __mi = 0, __s = 0) => ({__gregor: 'datetime', year: Number(__y), month: Number(__mo), day: Number(__d), hour: Number(__h), minute: Number(__mi), second: Number(__s)});\n const __parse_date = (__s) => { const __m = String(__s).match(/^(\\d{4})-(\\d{2})-(\\d{2})$/); if (!__m) throw new Error('invalid date: ' + __s); return __date(__m[1], __m[2], __m[3]); };\n const __parse_time = (__s) => { const __m = String(__s).match(/^(\\d{2}):(\\d{2})(?::(\\d{2}))?$/); if (!__m) throw new Error('invalid time: ' + __s); return __time(__m[1], __m[2], __m[3] || 0); };\n const __parse_datetime = (__s) => { const __m = String(__s).match(/^(\\d{4})-(\\d{2})-(\\d{2})[T ](\\d{2}):(\\d{2})(?::(\\d{2}))?(?:Z|[+-]\\d{2}:?\\d{2})?$/); if (!__m) throw new Error('invalid datetime: ' + __s); return __datetime(__m[1], __m[2], __m[3], __m[4], __m[5], __m[6] || 0); };\n const __from_js_date = (__x) => __datetime(__x.getFullYear(), __x.getMonth() + 1, __x.getDate(), __x.getHours(), __x.getMinutes(), __x.getSeconds());\n const __to_js_date = (__x) => { if (__x instanceof Date) return __x; if (__x.__gregor === 'date') return new Date(__x.year, __x.month - 1, __x.day); if (__x.__gregor === 'time') return new Date(1970, 0, 1, __x.hour, __x.minute, __x.second || 0); return new Date(__x.year, __x.month - 1, __x.day, __x.hour || 0, __x.minute || 0, __x.second || 0); };\n const __date_string = (__x) => `${__pad(__x.year, 4)}-${__pad(__x.month)}-${__pad(__x.day)}`;\n const __time_string = (__x) => `${__pad(__x.hour)}:${__pad(__x.minute)}:${__pad(__x.second || 0)}`;\n const __datetime_string = (__x) => `${__pad(__x.year, 4)}-${__pad(__x.month)}-${__pad(__x.day)}T${__pad(__x.hour || 0)}:${__pad(__x.minute || 0)}:${__pad(__x.second || 0)}`;\n const __kind = (__x) => (__x && __x.__gregor) || (__x instanceof Date ? 'js-date' : false);\n const __get = (__x, __field) => { if (__x instanceof Date) { const __m = {year: __x.getFullYear(), month: __x.getMonth() + 1, day: __x.getDate(), hour: __x.getHours(), minute: __x.getMinutes(), second: __x.getSeconds()}; return __m[__field]; } return __x[__field]; };\n return __rkt_body({date: __date, time: __time, datetime: __datetime, parseDate: __parse_date, parseTime: __parse_time, parseDateTime: __parse_datetime, fromJSDate: __from_js_date, toJSDate: __to_js_date, dateString: __date_string, timeString: __time_string, dateTimeString: __datetime_string, kind: __kind, get: __get});\n})((__g) => ~a)" expr)) + + (define (compile-gregor op args) + (define lname (identifier-local-name op)) + (define (one who) (match args [(list x) x] [_ (fail who args)])) + (define (one/two who) (match args [(list x) x] [(list x _fmt) x] [_ (fail who args)])) + (define (date3 who) + (match args [(list y m d) (inline-gregor-runtime (format "__g.date(~a, ~a, ~a)" (compile-expr y) (compile-expr m) (compile-expr d)))] [_ (fail who args)])) + (define (time2/3 who) + (match args + [(list h m) (inline-gregor-runtime (format "__g.time(~a, ~a, 0)" (compile-expr h) (compile-expr m)))] + [(list h m s) (inline-gregor-runtime (format "__g.time(~a, ~a, ~a)" (compile-expr h) (compile-expr m) (compile-expr s)))] + [_ (fail who args)])) + (define (dt who) + (match args + [(list y mo d h mi) (inline-gregor-runtime (format "__g.datetime(~a, ~a, ~a, ~a, ~a, 0)" (compile-expr y) (compile-expr mo) (compile-expr d) (compile-expr h) (compile-expr mi)))] + [(list y mo d h mi s) (inline-gregor-runtime (format "__g.datetime(~a, ~a, ~a, ~a, ~a, ~a)" (compile-expr y) (compile-expr mo) (compile-expr d) (compile-expr h) (compile-expr mi) (compile-expr s)))] + [_ (fail who args)])) + (case (string->symbol lname) + [(string->date parse-date) (inline-gregor-runtime (format "__g.parseDate(~a)" (compile-expr (one/two op))))] + [(date->string) (inline-gregor-runtime (format "__g.dateString(~a)" (compile-expr (one op))))] + [(string->time parse-time) (inline-gregor-runtime (format "__g.parseTime(~a)" (compile-expr (one/two op))))] + [(time->string) (inline-gregor-runtime (format "__g.timeString(~a)" (compile-expr (one op))))] + [(string->datetime parse-moment parse-datetime) (inline-gregor-runtime (format "__g.parseDateTime(~a)" (compile-expr (one/two op))))] + [(datetime->string moment->string) (inline-gregor-runtime (format "__g.dateTimeString(~a)" (compile-expr (one op))))] + [(date make-date) (date3 op)] + [(time make-time) (time2/3 op)] + [(datetime moment make-datetime make-moment) (dt op)] + [(date?) (inline-gregor-runtime (format "(__g.kind(~a) === 'date')" (compile-expr (one op))))] + [(time?) (inline-gregor-runtime (format "(__g.kind(~a) === 'time')" (compile-expr (one op))))] + [(datetime? moment?) (inline-gregor-runtime (format "(__g.kind(~a) === 'datetime' || __g.kind(~a) === 'js-date')" (compile-expr (one op)) (compile-expr (one op))))] + [(->year year) (inline-gregor-runtime (format "__g.get(~a, 'year')" (compile-expr (one op))))] + [(->month month) (inline-gregor-runtime (format "__g.get(~a, 'month')" (compile-expr (one op))))] + [(->day day) (inline-gregor-runtime (format "__g.get(~a, 'day')" (compile-expr (one op))))] + [(->hours hours) (inline-gregor-runtime (format "__g.get(~a, 'hour')" (compile-expr (one op))))] + [(->minutes minutes) (inline-gregor-runtime (format "__g.get(~a, 'minute')" (compile-expr (one op))))] + [(->seconds seconds) (inline-gregor-runtime (format "__g.get(~a, 'second')" (compile-expr (one op))))] + [(->js-date) (inline-gregor-runtime (format "__g.toJSDate(~a)" (compile-expr (one op))))] + [(js-date->datetime) (inline-gregor-runtime (format "__g.fromJSDate(~a)" (compile-expr (one op))))] + [else #f])) + + (define (compile-division args) + ;; JavaScript produces Infinity for 10 / 0, while Racket raises an + ;; exception for exact division by zero. This subset uses a runtime + ;; zero-check so with-handlers can catch the common division-by-zero case. + (when (null? args) (fail "empty / operator" args)) + (define temps (for/list ([_ (in-list args)]) (fresh "div"))) + (define bindings + (for/list ([tmp (in-list temps)] [arg (in-list args)]) + (format "const ~a = ~a;" tmp (compile-expr arg)))) + (define denominators (if (= (length temps) 1) temps (cdr temps))) + (define checks + (for/list ([tmp (in-list denominators)]) + (format "if (~a === 0) throw new Error(\"division by zero\");" tmp))) + (define result + (if (= (length temps) 1) + (format "(1 / ~a)" (car temps)) + (parens (string-join temps " / ")))) + (format "(() => ~a)()" + (block (join-lines (append bindings checks (list (format "return ~a;" result))))))) + + (define (compile-operator op args) + (or (compile-gregor op args) + (let () + (define (binary jsop [empty #f] [single-prefix #f]) + (cond + [(null? args) (or empty (fail "empty operator" op))] + [(and (= (length args) 1) single-prefix) (format "(~a~a)" single-prefix (compile-expr (car args)))] + [else (parens (string-join (map compile-expr args) (format " ~a " jsop)))])) + (case op + [(+) (if (null? args) "0" (binary "+"))] + [(*) (if (null? args) "1" (binary "*"))] + [(-) (binary "-" #f "-")] + [(/) (compile-division args)] + [(quotient) (format "Math.trunc(~a / ~a)" (compile-expr (car args)) (compile-expr (cadr args)))] + [(remainder modulo) (binary "%")] + [(add1) (format "(~a + 1)" (compile-expr (car args)))] + [(sub1) (format "(~a - 1)" (compile-expr (car args)))] + [(abs) (format "Math.abs(~a)" (compile-expr (car args)))] + [(floor) (format "Math.floor(~a)" (compile-expr (car args)))] + [(ceiling) (format "Math.ceil(~a)" (compile-expr (car args)))] + [(round) (format "Math.round(~a)" (compile-expr (car args)))] + [(max) (format "Math.max(~a)" (string-join (map compile-expr args) ", "))] + [(min) (format "Math.min(~a)" (string-join (map compile-expr args) ", "))] + [(sqrt) (format "Math.sqrt(~a)" (compile-expr (car args)))] + [(sqr) (format "((__x) => __x * __x)(~a)" (compile-expr (car args)))] + [(expt) (format "Math.pow(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))] + [(sin cos tan asin acos atan log exp) (format "Math.~a(~a)" (symbol->string op) (string-join (map compile-expr args) ", "))] + [(zero?) (format "(~a === 0)" (compile-expr (car args)))] + [(positive?) (format "(~a > 0)" (compile-expr (car args)))] + [(negative?) (format "(~a < 0)" (compile-expr (car args)))] + [(even?) (format "(~a % 2 === 0)" (compile-expr (car args)))] + [(odd?) (format "(~a % 2 !== 0)" (compile-expr (car args)))] + [(= ==) (compile-comparison "===" args)] + [(equal?) (compile-deep-equal args)] + [(eq? eqv?) (compile-object-is args)] + [(!= not-equal?) (format "!(~a)" (compile-deep-equal args))] + [(< > <= >=) (compile-comparison (symbol->string op) args)] + [(and) (compile-and args)] + [(or) (compile-or args)] + [(not) (format "(~a === false)" (compile-expr (car args)))] + [(list vector) (format "[~a]" (string-join (map compile-expr args) ", "))] + [(cons) (format "[~a].concat(~a)" (compile-expr (car args)) (compile-expr (cadr args)))] + [(append) (if (null? args) "[]" (format "[].concat(~a)" (string-join (map compile-expr args) ", ")))] + [(car first) (format "~a[0]" (parens (compile-expr (car args))))] + [(cdr rest) (format "~a.slice(1)" (parens (compile-expr (car args))))] + [(cadr second) (format "~a[1]" (parens (compile-expr (car args))))] + [(caddr third) (format "~a[2]" (parens (compile-expr (car args))))] + [(length vector-length string-length) (format "~a.length" (parens (compile-expr (car args))))] + [(list-ref vector-ref string-ref) (format "~a[~a]" (parens (compile-expr (car args))) (compile-expr (cadr args)))] + [(null? empty?) (format "Array.isArray(~a) && ~a.length === 0" (compile-expr (car args)) (parens (compile-expr (car args))))] + [(pair?) (format "Array.isArray(~a) && ~a.length > 0" (compile-expr (car args)) (parens (compile-expr (car args))))] + [(list? vector?) (format "Array.isArray(~a)" (compile-expr (car args)))] + [(number? real? integer?) (format "typeof ~a === \"number\"" (compile-expr (car args)))] + [(string?) (format "typeof ~a === \"string\"" (compile-expr (car args)))] + [(boolean?) (format "typeof ~a === \"boolean\"" (compile-expr (car args)))] + [(symbol?) (format "typeof ~a === \"string\"" (compile-expr (car args)))] + [(void) "undefined"] + [(values) (if (= (length args) 1) (compile-expr (car args)) (format "[~a]" (string-join (map compile-expr args) ", ")))] + [(string-append) (if (null? args) "\"\"" (binary "+"))] + [(substring) + (match args + [(list s start) (format "~a.substring(~a)" (parens (compile-expr s)) (compile-expr start))] + [(list s start end) (format "~a.substring(~a, ~a)" (parens (compile-expr s)) (compile-expr start) (compile-expr end))] + [_ (fail "substring" args)])] + [(string-upcase) (format "~a.toUpperCase()" (parens (compile-expr (car args))))] + [(string-downcase) (format "~a.toLowerCase()" (parens (compile-expr (car args))))] + [(string-trim) (format "~a.trim()" (parens (compile-expr (car args))))] + [(string-contains?) (format "~a.includes(~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))] + [(regexp? pregexp?) (format "(~a instanceof RegExp || typeof ~a === \"string\")" (compile-expr (car args)) (compile-expr (car args)))] + [(regexp-match) (compile-regexp-match args)] + [(regexp-match?) (compile-regexp-match? args)] + [(regexp-match*) (compile-regexp-match* args)] + [(regexp-match-positions) (compile-regexp-match-positions args)] + [(regexp-split) (compile-regexp-split args)] + [(regexp-replace) (compile-regexp-replace args #:all? #f)] + [(regexp-replace*) (compile-regexp-replace args #:all? #t)] + [(regexp-quote) (compile-regexp-quote args)] + [(string=? string-ci=?) (compile-comparison "===" args)] + [(string? string<=? string>=?) + (compile-comparison (case op [(string?) ">"] [(string<=?) "<="] [(string>=?) ">="]) args)] + [(number->string symbol->string string->symbol) (format "String(~a)" (compile-expr (car args)))] + [(string->number) (format "Number(~a)" (compile-expr (car args)))] + [(displayln) (format "console.log(~a)" (string-join (map compile-expr args) ", "))] + [(display) (format "console.log(~a)" (string-join (map compile-expr args) ", "))] + [(hash) (compile-hash args)] + [(hash-ref) + (match args + [(list h k) (format "~a[~a]" (parens (compile-expr h)) (compile-expr k))] + [(list h k default) (format "((__h, __k) => Object.prototype.hasOwnProperty.call(__h, __k) ? __h[__k] : ~a)(~a, ~a)" (compile-expr default) (compile-expr h) (compile-expr k))] + [_ (fail "hash-ref" args)])] + [(hash-set) (format "Object.assign({}, ~a, { [~a]: ~a })" (compile-expr (car args)) (compile-expr (cadr args)) (compile-expr (caddr args)))] + [(hash-has-key?) (format "Object.prototype.hasOwnProperty.call(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))] + [(hash-keys) (format "Object.keys(~a)" (compile-expr (car args)))] + [(hash-values) (format "Object.values(~a)" (compile-expr (car args)))] + [(reverse) (format "[...~a].reverse()" (parens (compile-expr (car args))))] + [(take) (format "~a.slice(0, ~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))] + [(drop) (format "~a.slice(~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))] + [(member memq memv) (format "~a.includes(~a)" (parens (compile-expr (cadr args))) (compile-expr (car args)))] + [(map) + (match args + [(list f xs) (format "~a.map((__x) => ~a(__x))" (parens (compile-expr xs)) (compile-expr f))] + [(list f xs more ...) + (format "((__arrays) => __arrays[0].map((_, __i) => ~a(...__arrays.map((__a) => __a[__i]))))([~a])" + (compile-expr f) (string-join (map compile-expr (cons xs more)) ", "))] + [_ (fail "map" args)])] + [(filter) (format "~a.filter((__x) => (~a(__x) !== false))" (parens (compile-expr (cadr args))) (compile-expr (car args)))] + [(foldl) (format "~a.reduce((__acc, __x) => ~a(__x, __acc), ~a)" (parens (compile-expr (caddr args))) (compile-expr (car args)) (compile-expr (cadr args)))] + [(foldr) (format "~a.reduceRight((__acc, __x) => ~a(__x, __acc), ~a)" (parens (compile-expr (caddr args))) (compile-expr (car args)) (compile-expr (cadr args)))] + [(apply) + (match args + [(list f last-arg) (format "~a(...~a)" (compile-expr f) (compile-expr last-arg))] + [(list f fixed ... last-arg) (format "~a(~a, ...~a)" (compile-expr f) (string-join (map compile-expr fixed) ", ") (compile-expr last-arg))] + [_ (fail "apply" args)])] + [(error) (format "(() => { throw new Error(~a); })()" (if (null? args) "\"error\"" (compile-expr (car args))))] + [(raise) (format "(() => { throw ~a; })()" (if (null? args) "new Error(\"raise\")" (compile-expr (car args))))] + [(exn?) (if (null? args) "true" "true")] + [(exn-message) (format "String((~a && ~a.message !== undefined) ? ~a.message : ~a)" (compile-expr (car args)) (compile-expr (car args)) (compile-expr (car args)) (compile-expr (car args)))] + [else #f])))) + + (define (compile-call f args) + (or (and (symbol? f) (compile-operator f args)) + (match f + ['send (match args + [(list obj method more ...) + (format "~a.~a(~a)" (compile-expr obj) (prop->js method) (string-join (map compile-expr more) ", "))] + [_ (fail "send" args)])] + ['new (match args + [(list cls more ...) (format "new ~a(~a)" (compile-expr cls) (string-join (map compile-expr more) ", "))] + [_ (fail "new" args)])] + ['js-ref (match args + [(list obj key) (format "~a[~a]" (compile-expr obj) (compile-expr key))] + [_ (fail "js-ref" args)])] + ['js-dot (match args + [(list obj (? symbol? key)) (format "~a.~a" (compile-expr obj) (prop->js key))] + [_ (fail "js-dot" args)])] + ['js-delete (match args + [(list obj key) (parens (compile-delete-target obj key))] + [_ (fail "js-delete" args)])] + ['array (format "[~a]" (string-join (map compile-expr args) ", "))] + ['object (compile-hash args)] + [_ (format "~a(~a)" (compile-callee f) (string-join (map compile-expr args) ", "))]))) + + (define (compile-expr d) + (match d + [(? boolean?) (if d "true" "false")] + [(? regexp?) (compile-regexp-literal d)] + [(? byte-regexp?) (fail "byte regexp literal" d)] + [(? number?) (number->string d)] + [(? string?) (js-string d)] + [(? char?) (js-string (string d))] + [(? keyword?) (js-string (keyword->string d))] + ['js-null "null"] + ['js-undefined "undefined"] + ['js-NaN "NaN"] + [(? symbol?) (id->js d)] + [(list 'quote v) (literal->js v)] + [(list 'quasiquote v) (literal->js v)] + [(list 'lambda formals body ...) + (format "function(~a) ~a" (compile-formals formals) (block (compile-body body #:return-last? #t)))] + [(list '位 formals body ...) + (format "function(~a) ~a" (compile-formals formals) (block (compile-body body #:return-last? #t)))] + [(list 'if c t e) (compile-if-expr c t e)] + [(list 'begin es ...) (compile-begin-expr es)] + [(list 'while c body ...) + (format "(() => ~a)()" + (block (join-lines + (list (format "while (~a) ~a" (compile-test c) (block (compile-body body))) + "return undefined;"))))] + [(list 'begin0 first rest ...) + (define tmp "__begin0_value") + (format "(() => ~a)()" (block (join-lines (append (list (format "const ~a = ~a;" tmp (compile-expr first))) + (map compile-stmt rest) + (list (format "return ~a;" tmp))))))] + [(list 'let name bindings body ...) #:when (symbol? name) + (compile-named-let name bindings body #:return-last? #t #:as-expression? #t)] + [(list 'let bindings body ...) + (compile-let 'let bindings body #:return-last? #t #:as-expression? #t)] + [(list 'let* bindings body ...) + (compile-let 'let* bindings body #:return-last? #t #:as-expression? #t)] + [(list 'letrec bindings body ...) + (compile-let 'letrec bindings body #:return-last? #t #:as-expression? #t)] + [(list 'let-values bindings body ...) + (compile-let-values 'let-values bindings body #:return-last? #t #:as-expression? #t)] + [(list 'let*-values bindings body ...) + (compile-let-values 'let*-values bindings body #:return-last? #t #:as-expression? #t)] + [(list 'cond clauses ...) + (format "(() => ~a)()" (block (compile-cond clauses #:return-last? #t)))] + [(list 'case key clauses ...) + (format "(() => ~a)()" (block (compile-case key clauses #:return-last? #t)))] + [(list 'with-handlers clauses body ...) + (compile-with-handlers clauses body #:return-last? #t #:as-expression? #t)] + [(list 'for/list clauses body ...) + (compile-for clauses body #:collect? #t #:as-expression? #t)] + [(list 'for/vector clauses body ...) + (compile-for clauses body #:collect? #t #:as-expression? #t)] + [(list 'for clauses body ...) + (compile-for clauses body #:collect? #f #:as-expression? #t)] + [(list 'for/fold bindings clauses body ...) + (compile-for-fold bindings clauses body)] + [(list 'when c body ...) + (format "(() => ~a)()" (block (compile-return `(when ,c ,@body))))] + [(list 'unless c body ...) + (format "(() => ~a)()" (block (compile-return `(unless ,c ,@body))))] + [(list 'let-object bindings obj body ...) + (compile-let-object bindings obj body #:return-last? #t #:as-expression? #t)] + [(list 'js-delete obj key) + (parens (compile-delete-target obj key))] + [(list 'set-prop! obj key val) + (format "(~a[~a] = ~a)" (compile-expr obj) (compile-expr key) (compile-expr val))] + [(list 'set! target rhs) + (format "(~a = ~a)" (compile-assignment-target target) (compile-expr rhs))] + [(list 'return) "undefined"] + [(list 'return e) (compile-expr e)] + [(list f args ...) (compile-call f args)] + [_ (literal->js d)])) + + (define (compile-top forms) + (compile-body forms #:return-last? #f))) + +(define-syntax (js stx) + (syntax-case stx () + [(_ form ...) + (datum->syntax stx (compile-top (syntax->datum #'(form ...))))])) + +(define-syntax (js/expression stx) + (syntax-case stx () + [(_ form) + (datum->syntax stx (compile-expr (syntax->datum #'form)))])) diff --git a/private/syntax-helpers.rkt b/private/syntax-helpers.rkt new file mode 100644 index 0000000..5ff7537 --- /dev/null +++ b/private/syntax-helpers.rkt @@ -0,0 +1,42 @@ +#lang racket/base + +(require racket/string + "utils.rkt" + ) +(provide symbol?? + symstr + symstr-eval + is-if?) + + +(define (symbol?? a) + (let ((r (symbol? a))) + r)) + +(define (symstr x) + (cond + ((list? x) + (string-append "[ " + (string-join (map symstr-eval x) ", ") + " ]")) + ((vector? x) + (symstr (vector->list x))) + (else + (let ((r (format "~a" x))) + (let ((r* (if (string-prefix? r "(quote") + (let ((s (substring r 7))) + (substring s 0 (- (string-length s) 1))) + r))) + r*))) + ) + ) + + +(define (symstr-eval x) + (cond + ((string? x) (format "\"~a\"" (esc-double-quote x))) + (else (symstr x)))) + +(define (is-if? x) + (displayln x) + (eq? x 'if)) \ No newline at end of file diff --git a/private/utils.rkt b/private/utils.rkt new file mode 100644 index 0000000..f7ef90d --- /dev/null +++ b/private/utils.rkt @@ -0,0 +1,209 @@ +#lang racket/base + +(require racket/string + racket/port + racket/contract + json + (prefix-in g: gregor) + (prefix-in g: gregor/time) + gregor-utils + racket-sprintf + simple-log + ) + +(provide while + until + get-lib-path + do-for + esc-quote + esc-double-quote + fromJson + mk-js-array + js-code + kv-1 + kv-2 + make-kv + kv? + list-of-kv? + list-of-symbol? + list-of? + string->time + time->string + string->date + date->string + string->datetime + datetime->string + + dbg-webview + err-webview + info-webview + warn-webview + fatal-webview + sync-log-webview + + ) + + +(sl-def-log webview) + +(define-syntax while +(syntax-rules () + ((_ cond body ...) + (letrec ((while-f (lambda (last-result) + (if cond + (let ((last-result (begin + body + ...))) + (while-f last-result)) + last-result)))) + (while-f #f)) + ) + )) + +(define-syntax until +(syntax-rules () + ((_ cond body ...) + (letrec ((until-f (lambda (last-result) + (if cond + last-result + (let ((last-reult (begin + body + ...))) + (until-f last-result)))))) + (until-f #f))))) + +(define-syntax do-for +(syntax-rules () + ((_ (init cond next) body ...) + (begin + init + (letrec ((do-for-f (lamba () + (if cond + (begin + (begin + body + ...) + next + (do-for-f)))))) + (do-for-f)))))) + +(define (get-lib-path lib) +(let ((platform (system-type))) + (cond + [(eq? platform 'windows) + (let ((try1 (build-path (current-directory) ".." "lib" "dll" lib)) + (try2 (build-path (current-directory) "lib" "dll" lib))) + (if (file-exists? try1) + try1 + try2) + )] + [else + (error (format "Install the shared library: ~a" lib))] + ))) + +(define (esc-quote str) + (string-replace (string-replace str "\\" "\\\\") "'" "\\'")) + +(define (esc-double-quote str) + (string-replace (string-replace str "\\" "\\\\") "\"" "\\\"")) + +(define (fromJson str) + (with-input-from-string str read-json)) + +(define (mk-js-array l) + (if (list-of-kv? l) + (string-append "[ " (string-join (map (位 (e) (mk-js-array e)) l) ", ") " ]") + (if (list? l) + (string-append "[ " (string-join (map (位 (e) (format "'~a'" + (esc-quote (format "~a" e)))) l) ", ") " ]") + (if (pair? l) + (format "[ '~a', '~a' ]" (car l) (cdr l)) + (format "[ '~a' ]" (esc-quote (format "~a" l))))))) + +(define (js-code . a) + (define (code* l) + (if (null? l) + "" + (string-append (car l) "\n" (code* (cdr l))) + ) + ) + (code* a)) + +(define (kv? e) + (or + (and (list? e) (= (length e) 2) (symbol? (car e))) + (and (pair? e) (symbol? (car e))))) + +(define/contract (kv-1 e) + (-> kv? symbol?) + (car e)) + +(define/contract (kv-2 e) + (-> kv? any/c) + (if (list? e) + (cadr e) + (cdr e))) + +(define/contract (make-kv k v) + (-> symbol? any/c kv?) + (if (list? v) + (list k v) + (cons k v))) + +(define (list-of? pred? l) + (define (all-pred? l) + (if (null? l) + #t + (if (pred? (car l)) + (all-pred? (cdr l)) + #f))) + (if (list? l) + (all-pred? l) + #f)) + +(define (list-of-kv? l) + (list-of? kv? l)) + +(define (list-of-symbol? l) + (list-of? symbol? l)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Date / Time conversion +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (string->time s) + (with-handlers ([exn:fail? + (位 (e) (g:parse-time s "HH:mm"))]) + (g:parse-time s "HH:mm:ss"))) + +(define (time->string t) + (unless (or (g:time? t) (g:datetime? t) (g:moment? t)) + (error "set! - gregor time?, moment? or datetime? expected")) + (sprintf "%02d:%02d:%02d" (g:->hours t) (g:->minutes t) (g:->seconds t))) + +(define (string->datetime s) + (with-handlers ([exn:fail? + (位 (e) (g:parse-moment s "yyyy-MM-dd'T'HH:mm:ss"))]) + (g:parse-moment s "yyyy-MM-dd'T'HH:mm"))) + +(define (datetime->string dt) + (when (racket-date? dt) + (datetime->string date->moment dt)) + (unless (or (g:datetime? dt) (g:moment? dt) (g:date? dt) (g:time? dt)) + (error "set! - gregor time? , date?, datetime? or moment? expected")) + (sprintf "%04d:%02d:%02dT%02d:%02d:%02d" + (g:->year dt) (g:->month dt) (g:->day dt) + (g:->hours dt) (g:->minutes dt) (g:->seconds dt)) + ) + +(define (string->date d) + (g:parse-date d "yyyy-MM-dd")) + +(define (date->string d) + (when (racket-date? d) + (date->string (date->moment d))) + (unless (or (g:date? d) (g:moment? d) (g:datetime? d)) + (error "set! - gregor date expected")) + (sprintf "%04d-%02d-%02d" (g:->year d) (g:->month d) (g:->day d))) + + diff --git a/scrbl/.gitignore b/scrbl/.gitignore new file mode 100644 index 0000000..e681bac --- /dev/null +++ b/scrbl/.gitignore @@ -0,0 +1,5 @@ +*.html +*.js +*.css +*.bak +*.scrbl~ diff --git a/scrbl/jsmaker.scrbl b/scrbl/jsmaker.scrbl new file mode 100644 index 0000000..147bc7b --- /dev/null +++ b/scrbl/jsmaker.scrbl @@ -0,0 +1,245 @@ +#lang scribble/manual + +@(require (for-label racket/base + racket/list + racket/string + "../main.rkt")) + +@title{jsmaker} +@author+email["Hans Dijkema" ""] + +@defmodule[jsmaker] + +The @racketmodname[jsmaker] collection provides two syntax forms that +translate a practical subset of Racket expressions to JavaScript source code. +The translation is syntax-driven: the Racket expression is not evaluated, but +is inspected by the macro and emitted as a JavaScript string. + +The goal is not to implement a complete Racket compiler. The goal is a useful +and predictable source generator for small pieces of JavaScript, including +callbacks, browser-facing functions, simple data processing, regular +expressions, and some date/time helper forms. + +@section{Public API} + +@defform[(js form ...)]{ +Translates one or more Racket forms to JavaScript statement code. The result +is a string. + +@racketblock[ +(js + (define (f x) + (if (and (> x 10) (< x 15)) + (begin + (console.log x) + (return x)) + (return (* x x))))) +] + +The generated JavaScript is statement-oriented: + +@codeblock{ +function f(x) { + if ((x > 10) && (x < 15)) { + console.log(x); + return x; + } else { + return (x * x); + } +} +} + +Inside function bodies, the final expression is returned automatically unless +an explicit @racket[return] form is used. +} + +@defform[(js/expression form)]{ +Translates a single Racket expression to a JavaScript expression string. + +@racketblock[ +(js/expression + (let loop ([i 0] [acc 0]) + (if (< i 5) + (loop (+ i 1) (+ acc i)) + acc))) +] + +Tail-recursive named @racket[let] loops are lowered to JavaScript +@tt{while (true)} loops when the recursive call is in tail position. +} + +@section{Supported expression subset} + +The supported subset includes literals, identifiers, function calls, +@racket[lambda], @racket[位], @racket[define], @racket[set!], @racket[if], +@racket[begin], @racket[begin0], @racket[cond], @racket[case], @racket[let], +@racket[let*], @racket[letrec], @racket[let-values], @racket[let*-values], +named @racket[let], @racket[when], @racket[unless], @racket[while], +@racket[for], @racket[for/list], @racket[for/vector], and +@racket[for/fold]. + +The common arithmetic, comparison, list/vector/string, hash, and higher-order +forms used in the regression suite are also supported. Examples include +@racket[+], @racket[-], @racket[*], @racket[/], @racket[quotient], +@racket[remainder], @racket[<], @racket[<=], @racket[>], @racket[>=], +@racket[=], @racket[equal?], @racket[and], @racket[or], @racket[not], +@racket[list], @racket[vector], @racket[cons], @racket[append], +@racket[map], @racket[filter], @racket[foldl], @racket[foldr], +@racket[substring], @racket[string-append], @racket[hash], and +@racket[hash-ref]. + +@section{Truthiness and boolean simplification} + +Racket treats only @racket[#f] as false. JavaScript treats many values as +false. The generator therefore preserves Racket truthiness where needed. +When a form is known to produce a JavaScript boolean, the generator emits +simpler JavaScript. For example: + +@racketblock[ +(js/expression (and (> x 10) (< x 15))) +] + +emits: + +@codeblock{ +((x > 10) && (x < 15)) +} + +A chained comparison such as @racket[(< x y 10)] is emitted directly when all +reused operands are simple: + +@codeblock{ +((x < y) && (y < 10)) +} + +When an intermediate expression might have side effects, the generator uses +temporaries so the expression is evaluated once and in order. + +@section{Regular expressions} + +Racket @tt{#rx} and common @tt{#px} patterns are translated to +JavaScript @tt{RegExp} values where the syntax is compatible. The generator +supports @racket[regexp?], @racket[pregexp?], @racket[regexp-match], +@racket[regexp-match?], @racket[regexp-match*], +@racket[regexp-match-positions], @racket[regexp-split], +@racket[regexp-replace], @racket[regexp-replace*], and +@racket[regexp-quote]. + +Match results are normalized to Racket-like values: a failed match becomes +@tt{false}, successful matches become JavaScript arrays, and an unmatched +optional capture becomes @tt{false}. + +The regexp support is deliberately conservative. Known incompatible constructs +such as inline option groups and atomic groups are rejected instead of being +silently miscompiled. + +@section{Exceptions} + +A small @racket[with-handlers] subset is supported: + +@racketblock[ +(js/expression + (with-handlers ([exn? (lambda (e) + (string-append "caught:" (exn-message e)))]) + (error "boom"))) +] + +The generated JavaScript uses @tt{try}/@tt{catch}. Only a generic +@racket[exn?] predicate is supported. Handler procedures are emitted as +function expressions in callee position, so rest-argument handlers such as +@racket[(lambda args ...)] are valid JavaScript. Division by zero in +@racket[/] is checked at run time and throws a JavaScript @tt{Error}, which +this subset can catch with @racket[with-handlers]. The generator does not +model Racket's exception hierarchy, continuable exceptions, exception marks, +or the full exact/inexact numeric distinction. + +@section{Gregor-style date and time helpers} + +The generator includes a small JavaScript-side representation for a subset of +Gregor-style date/time operations. Prefixes are not hardcoded. A call such as +@racket[(g:date 2026 5 25)], @racket[(gregor:date 2026 5 25)], or +@racket[(date 2026 5 25)] is matched by the local name @racket[date]. + +Supported local names include @racket[date], @racket[time], @racket[datetime], +@racket[moment], @racket[parse-date], @racket[parse-time], +@racket[parse-datetime], @racket[parse-moment], @racket[string->date], +@racket[string->time], @racket[string->datetime], @racket[date->string], +@racket[time->string], @racket[datetime->string], @racket[moment->string], +@racket[date?], @racket[time?], @racket[datetime?], @racket[moment?], +@racket[->year], @racket[->month], @racket[->day], @racket[->hours], +@racket[->minutes], @racket[->seconds], @racket[->js-date], and +@racket[js-date->datetime]. + +Plain dates and times are represented as tagged JavaScript objects rather than +native @tt{Date} objects, avoiding accidental timezone shifts. Use +@racket[->js-date] when a native JavaScript @tt{Date} is desired. + +@section{JavaScript interop forms} + +Several forms are emitted as direct JavaScript interop: + +@itemlist[#:style 'compact + @item{@racket[(send obj method arg ...)] emits @tt{obj.method(arg, ...)}.} + @item{@racket[(new cls arg ...)] emits @tt{new cls(arg, ...)}.} + @item{@racket[(js-ref obj key)] emits @tt{obj[key]}.} + @item{@racket[(js-dot obj field)] emits @tt{obj.field}.} + @item{@racket[(object key value ...)] emits a JavaScript object literal.} + @item{@racket[(array value ...)] emits a JavaScript array literal.}] + + +@section{JavaScript use case demos} + +The @filepath{demo/js-usecases.rkt} file contains a set of practical JavaScript +examples written in the Racket surface syntax accepted by @racket[js]. The +module also writes @filepath{demo/js-usecases.generated.js}, which contains the +generated JavaScript snippets wrapped as callable demo functions. + +The corresponding tests are in @filepath{testing/jsmaker-usecases.rkt} and are +included by @filepath{testing/jsmaker-regressions.rkt}. These tests execute the +generated JavaScript with the configured JavaScript executor. Promise-valued +results are awaited by the test framework, which allows examples such as Fetch +API success/error handling to be checked directly. + +The use case set covers random numbers, @tt{Set}, JavaScript falsey values, +currying, object destructuring, intervals, object property get/set/delete, +string concatenation order, @tt{Object.freeze} and @tt{Object.seal}, switch/case, +classes with constructor defaults, sorting objects, array deletion techniques, +Bubble Sort, recursive Binary Search, @tt{Map} counting, DOM HTML access, +anagram checks, pair-sum checks, and Fetch API result/error handling. + +@section{Testing} + +The regression suite lives in @filepath{testing/}. The main entry point is +@filepath{testing/jsmaker-regressions.rkt}. The test framework searches for a +JavaScript engine such as Node, Deno, Bun, QuickJS, or another supported +executor. If no engine is available, the JavaScript test files are generated +and execution is skipped with warnings. This skip is intentional so package +tests do not fail on systems without a JavaScript runtime. + +The usual command is: + +@codeblock{ +raco test jsmaker/testing/jsmaker-regressions.rkt +} + +@section{Private compatibility files} + +The @filepath{private/} directory contains legacy helper material from the +source project. The current public @racketmodname[jsmaker] module, demos, and +regression tests do not require these helper files. They are kept in the +package layout for compatibility and are omitted from compilation and the test +entry point in @filepath{info.rkt}. + +@section{Limitations} + +This package is not a full Racket compiler. It does not expand arbitrary +Racket macros, implement modules, contracts, classes, continuations, parameters, +or the full numeric tower. Unsupported forms should fail explicitly rather than +silently generate JavaScript with different semantics. + +@section{Use-case documentation} + +The practical JavaScript examples are documented separately in +@other-doc['(lib "jsmaker/scrbl/usecases.scrbl")]. That document shows each +use case as Racket/js-maker source next to representative generated +JavaScript, and lists the behavior covered by the regression test. diff --git a/scrbl/usecases.scrbl b/scrbl/usecases.scrbl new file mode 100644 index 0000000..c23631d --- /dev/null +++ b/scrbl/usecases.scrbl @@ -0,0 +1,584 @@ +#lang scribble/manual + +@(require scribble/core + (for-label racket/base + "../main.rkt")) + +@(define (side-by-side racket-source js-source) + (tabular #:style 'boxed #:sep (hspace 2) + (list (list (bold "Racket / js-maker") (bold "Generated JavaScript")) + (list (verbatim racket-source) (verbatim js-source))))) + +@(define (tested s) + (nested #:style 'inset (bold "Tested behavior: ") s)) + +@title{jsmaker JavaScript Use Cases} +@author+email["Hans Dijkema" ""] + +@defmodule[jsmaker/demo/js-usecases] + +This document describes the practical JavaScript use cases in +@filepath{demo/js-usecases.rkt}. Each implementation is written as a Racket +snippet using @racket[js] and is tested by compiling it to JavaScript and +executing that JavaScript with the configured test executor. The corresponding +tests are in @filepath{testing/jsmaker-usecases.rkt}. + +The tests intentionally use @racket[js/expression] for their calls wherever +possible. Raw JavaScript remains only in small harness preambles, such as fake +@tt{setInterval}, fake DOM objects, and fake @tt{fetch}. + +@section{Running the examples} + +Generate the JavaScript examples with: + +@codeblock{ +racket demo/js-usecases.rkt +} + +Run the use-case regression tests with: + +@codeblock{ +racket testing/jsmaker-usecases.rkt +} + +@section{Use cases} + +@subsection{1. Random number between 1 and 5} + +@(side-by-side +#<string age)))))) +RKT +#< { + const { name: name, age: age = 0 } = person; + return (name + ":" + String(age)); + })(); +} +JS +) + +@(tested "The object { name: \"Ada\", age: 37 } is rendered as \"Ada:37\".") + +@subsection{6. Escaping a timer interval} + +@(side-by-side +#< { + const { a: a3 } = obj; + obj.b = 2; + obj["c"] = 3; + delete obj["a"]; + return [a1, a2, a3, obj.b, obj["c"], Object.hasOwn(obj, "a")]; + })(); +} +JS +) + +@(tested "The three reads produce 1, the two writes produce 2 and 3, and the deleted property is absent.") + +@subsection{8. String concatenation order} + +@(side-by-side +#< n 1) + (let* ([i 1]) + (while (< i n) + (when (> (list-ref a (- i 1)) (list-ref a i)) + (let* ([tmp (list-ref a (- i 1))]) + (vector-set! a (- i 1) (list-ref a i)) + (vector-set! a i tmp))) + (set! i (+ i 1)))) + (set! n (- n 1))) + (return a)))) +RKT +#< 1)) { + let i = 1; + while ((i < n)) { + if ((a[(i - 1)] > a[i])) { + let tmp = a[(i - 1)]; + a[(i - 1)] = a[i]; + a[i] = tmp; + } + i = (i + 1); + } + n = (n - 1); + } + return a; +} +JS +) + +@(tested "Sorting [5, 1, 4, 2, 8] yields [1, 2, 4, 5, 8].") + +@subsection{15. Recursive binary search} + +@(side-by-side +#< low high) + (return -1) + (let* ([mid (send Math floor (/ (+ low high) 2))] + [value (list-ref xs mid)]) + (cond + [(= value target) (return mid)] + [(< value target) (return (binarySearch xs target (+ mid 1) high))] + [else (return (binarySearch xs target low (- mid 1)))]))))) +RKT +#< high)) return -1; + let mid = Math.floor(((low + high) / 2)); + let value = xs[mid]; + if ((value === target)) return mid; + if ((value < target)) return binarySearch(xs, target, (mid + 1), high); + return binarySearch(xs, target, low, (mid - 1)); +} +JS +) + +@(tested "Searching 7 returns index 3; searching 4 returns -1.") + +@subsection{16. Count occurrences with Map} + +@(side-by-side +#<]*>/g, ''); }, + set textContent(v) { this.innerHTML = String(v); }, + insertAdjacentHTML: (position, html) => { state.afterParagraph.push([position, html]); } +}; +const heading = { + insertAdjacentHTML: (position, html) => { state.afterHeading.push([position, html]); } +}; +const document = { + querySelector: (selector) => { + if (selector === 'p') return paragraph; + if (selector === 'h1') return heading; + return false; + } +}; +JS + (jsexpr->string paragraph-text))) + +(define tests + (list + (js-program-test + 'dom-ex01-highlight-long-words + exercise01 + "paragraph.innerHTML" + (jsexpr->string "Short extraordinary words remain.") + #:preamble (dom-preamble "Short extraordinary words remain.")) + + (js-program-test + 'dom-ex02-add-source-link + exercise02 + "state.afterParagraph" + (jsexpr->string '(("afterend" "Source: ForceM Ipsum"))) + #:preamble (dom-preamble "Force ipsum text.")) + + (js-program-test + 'dom-ex03-split-sentences + exercise03 + "paragraph.innerHTML" + (jsexpr->string "First sentence.
Second sentence.
Third.
") + #:preamble (dom-preamble "First sentence. Second sentence. Third.")) + + (js-program-test + 'dom-ex04-count-words-after-heading + exercise04 + "state.afterHeading" + (jsexpr->string '(("afterend" "

4 words

"))) + #:preamble (dom-preamble "These are four words")) + + (js-program-test + 'dom-ex05-replace-punctuation-faces + exercise05 + "paragraph.innerHTML" + (jsexpr->string "Really馃 Yes馃槻 No馃") + #:preamble (dom-preamble "Really? Yes! No?")))) + +(define engine (find-js-engine)) +(run-jsmaker-regression 'jsmaker-dom-exercises tests "/tmp/jsmaker-dom-exercises.js" #:engine engine) diff --git a/testing/jsmaker-executors.rkt b/testing/jsmaker-executors.rkt new file mode 100644 index 0000000..c525511 --- /dev/null +++ b/testing/jsmaker-executors.rkt @@ -0,0 +1,164 @@ +#lang racket/base + +(require racket/file + racket/list + racket/match + racket/port + racket/string) + +(provide js-engine? + js-engine-name + js-engine-path + js-engine-kind + js-engine-version + js-run-result? + js-run-result-engine + js-run-result-status + js-run-result-stdout + js-run-result-stderr + js-run-result-success? + known-js-engine-names + find-js-engine + run-js-file) + +(struct js-engine (name path kind version-args) #:transparent) +(struct js-run-result (engine status stdout stderr) #:transparent) + +(define (path-string/non-empty? v) + (and (string? v) (not (string=? v "")))) + +(define (executable-file? p) + (and p (file-exists? p))) + +(define (getenv/path name) + (define v (getenv name)) + (and (path-string/non-empty? v) (string->path v))) + +(define engine-specs + ;; name aliases kind version-args extra-paths + '((node ("node" "nodejs") plain ("--version") + ("/opt/nvm/versions/node/v22.16.0/bin/node" "/usr/local/bin/node" "/usr/bin/node")) + (deno ("deno") plain ("--version") ()) + (bun ("bun") plain ("--version") ()) + (qjs ("qjs" "quickjs") plain ("-v") ()) + (d8 ("d8") plain ("--version") ()) + (jsc ("jsc") plain ("--version") ()) + (js ("js") plain ("--version") ()) + (chromium ("chromium" "chromium-browser" "google-chrome" "google-chrome-stable") chromium ("--version") + ("/usr/bin/chromium" "/usr/bin/chromium-browser" "/usr/bin/google-chrome")))) + +(define (known-js-engine-names) + (map car engine-specs)) + +(define (lookup-engine-spec name) + (define wanted (string-downcase (format "~a" name))) + (for/first ([spec (in-list engine-specs)] + #:when (or (string=? wanted (symbol->string (car spec))) + (member wanted (cadr spec)))) + spec)) + +(define (candidate-paths spec) + (match spec + [(list name aliases kind version-args extra-paths) + (append + (if (eq? name 'node) + (filter values (list (getenv/path "JSMAKER_NODE"))) + '()) + (filter values (list (getenv/path "JSMAKER_ENGINE_PATH"))) + (filter values (map find-executable-path aliases)) + (map string->path extra-paths))])) + +(define (make-engine-from-spec spec) + (match spec + [(list name aliases kind version-args extra-paths) + (for/first ([p (in-list (candidate-paths spec))] + #:when (executable-file? p)) + (js-engine name p kind version-args))])) + +(define (find-js-engine [requested (or (getenv "JSMAKER_ENGINE") "auto")]) + (define req (string-downcase requested)) + (cond + [(or (string=? req "") (string=? req "auto")) + (define browser-fallback? (getenv "JSMAKER_BROWSER_FALLBACK")) + (or (for*/first ([spec (in-list engine-specs)] + #:unless (and (not browser-fallback?) (eq? (car spec) 'chromium)) + [engine (in-value (make-engine-from-spec spec))] + #:when engine) + engine) + #f)] + [else + (define spec (lookup-engine-spec req)) + (and spec (make-engine-from-spec spec))])) + +(define (capture-timeout-seconds) + (define v (getenv "JSMAKER_ENGINE_TIMEOUT_SECONDS")) + (cond + [(and (path-string/non-empty? v) (string->number v)) => values] + [else 15])) + +(define (capture path args) + (with-handlers ([exn:fail? (lambda (e) (values 127 "" (exn-message e)))]) + (define-values (proc stdout stdin stderr) + (apply subprocess #f #f #f path args)) + (define waiter (thread (lambda () (subprocess-wait proc)))) + (define finished? (sync/timeout (capture-timeout-seconds) waiter)) + (unless finished? + (subprocess-kill proc #t) + (thread-wait waiter)) + (values (if finished? (subprocess-status proc) 124) + (port->string stdout) + (string-append (port->string stderr) + (if finished? "" "\nJavaScript engine timed out and was killed.\n"))))) + +(define (js-engine-version engine) + (define-values (status stdout stderr) + (capture (js-engine-path engine) (js-engine-version-args engine))) + (define s (string-trim (if (string=? stdout "") stderr stdout))) + (and (zero? status) (not (string=? s "")) s)) + +(define (plain-run-args engine js-path) + (case (js-engine-name engine) + [(deno) (list "run" "--quiet" js-path)] + [else (list js-path)])) + +(define (copy-js-as-browser-html js-path) + (define html-path (build-path (find-system-path 'temp-dir) + (format "jsmaker-browser-~a.html" (current-inexact-milliseconds)))) + (define js (file->string js-path)) + (call-with-output-file html-path + #:exists 'replace + (lambda (out) + (displayln "
" out)
+      (displayln "" out)))
+  html-path)
+
+(define (chromium-run engine js-path)
+  (define html-path (copy-js-as-browser-html js-path))
+  (define url (string-append "file://" (path->string html-path)))
+  (define args (list "--headless" "--disable-gpu" "--no-sandbox" "--dump-dom" url))
+  (define-values (status stdout stderr) (capture (js-engine-path engine) args))
+  (define browser-fail? (regexp-match? #rx"data-jsmaker-status=\"fail\"" stdout))
+  (js-run-result engine (if browser-fail? 1 status) stdout stderr))
+
+(define (run-js-file engine js-path)
+  (case (js-engine-kind engine)
+    [(chromium) (chromium-run engine js-path)]
+    [else
+     (define-values (status stdout stderr)
+       (capture (js-engine-path engine) (plain-run-args engine js-path)))
+     (js-run-result engine status stdout stderr)]))
+
+(define (js-run-result-success? result)
+  (zero? (js-run-result-status result)))
diff --git a/testing/jsmaker-program-regression.rkt b/testing/jsmaker-program-regression.rkt
new file mode 100644
index 0000000..58473df
--- /dev/null
+++ b/testing/jsmaker-program-regression.rkt
@@ -0,0 +1,118 @@
+#lang racket/base
+
+(require "../main.rkt"
+         "jsmaker-executors.rkt"
+         "jsmaker-test-framework.rkt")
+
+(define dom-preamble
+  (string-append
+   "const window = {};\n"
+   "const logs = [];\n"
+   "const attrs = {};\n"
+   "const console = { log: (...xs) => logs.push(xs.length === 1 ? xs[0] : xs) };\n"
+   "const document = {\n"
+   "  getElementById: (id) => id === 'hi'\n"
+   "    ? { setAttribute: (k, v) => { attrs[k] = v; }, getAttribute: (k) => attrs[k] || '' }\n"
+   "    : false\n"
+   "};"))
+
+(define t1-program
+  (js (set! window.myfunc (位 (x)
+                            (let* ((el (send document getElementById 'hi))
+                                   (old (send el getAttribute "x"))
+                                   (y (+ old (* x x))))
+                              (send el setAttribute "x" (+ y "")))
+                            (send console log "dit set attribute x on element hi")))))
+
+(define t2-program
+  (js (define (f x)
+        (if (and (> x 10) (< x 15))
+            (begin (console.log x)
+                   (return x))
+            (return (* x x))))))
+
+(define t3-program
+  (js (define (f x y z)
+        (send console log (cons x (cons y (list z))))
+        (let* ((l (cons x (cons y (list z)))))
+          (return (send l map (位 (a) (return (+ a 10)))))))))
+
+(define tail-loop-expression
+  (js/expression (let loop ([i 0] [s 0])
+                   (if (< i 5)
+                       (loop (+ i 1) (+ s i))
+                       s))))
+
+(unless (regexp-match? #rx"while \\(true\\)" tail-loop-expression)
+  (error 'jsmaker-program-regression
+         "tail-recursive named let was not lowered to while(true): ~a"
+         tail-loop-expression))
+
+(unless (regexp-match? #rx"\n  " t1-program)
+  (error 'jsmaker-program-regression
+         "generated statement code does not appear to contain indentation: ~a"
+         t1-program))
+
+(unless (regexp-match? #rx"if \\(\\(x > 10\\) && \\(x < 15\\)\\)" t2-program)
+  (error 'jsmaker-program-regression
+         "boolean and should compile directly in if test: ~a"
+         t2-program))
+
+(define program-tests
+  (list
+   (js-program-test
+    'dom-style-set-attribute
+    t1-program
+    "(() => { attrs.x = 'old:'; window.myfunc(4); return [attrs.x, logs]; })()"
+    "[\"old:16\",[\"dit set attribute x on element hi\"]]"
+    #:preamble dom-preamble)
+
+   (js-program-test
+    'define-if-return-console
+    t2-program
+    "(() => { const a = f(12); const b = f(5); return [a, b, logs]; })()"
+    "[12,25,[12]]"
+    #:preamble "const logs = []; const console = { log: (...xs) => logs.push(xs.length === 1 ? xs[0] : xs) };" )
+
+   (js-program-test
+    'define-send-map-return
+    t3-program
+    "(() => { const r = f(1, 2, 3); return [r, logs]; })()"
+    "[[11,12,13],[[1,2,3]]]"
+    #:preamble "const logs = []; const console = { log: (...xs) => logs.push(xs.length === 1 ? xs[0] : xs) };" )
+
+   (js-expression-test 'named-let-tail-big
+                       (js/expression (let loop ([i 0] [s 0])
+                                        (if (< i 100000)
+                                            (loop (+ i 1) (+ s 1))
+                                            s)))
+                       "100000")
+
+   (js-expression-test 'named-let-tail-accumulator tail-loop-expression "10")
+
+   (js-expression-test 'explicit-while-form
+                       (js/expression (let ([i 0] [s 0])
+                                        (while (< i 4)
+                                          (set! s (+ s i))
+                                          (set! i (+ i 1)))
+                                        s))
+                       "6")
+
+   (js-expression-test 'bare-return
+                       (js/expression ((lambda (x) (if x (return) (return 7))) #t))
+                       "undefined")
+
+   (js-expression-test 'implicit-last-expression-return
+                       (js/expression ((lambda (x) (+ x 10)) 5))
+                       "15")
+
+   (js-program-test
+    'with-handlers-rest-lambda-statement
+    (js (with-handlers ([exn? (位 args (displayln (length args)))])
+          (/ 10 0)))
+    "logs"
+    "[1]"
+    #:preamble "const logs = []; const console = { log: (...xs) => logs.push(xs.length === 1 ? xs[0] : xs) };")))
+
+(define engine (find-js-engine))
+(run-jsmaker-regression 'jsmaker-program-regression program-tests "/tmp/jsmaker-program-regression.js" #:engine engine)
diff --git a/testing/jsmaker-regexp-regression.rkt b/testing/jsmaker-regexp-regression.rkt
new file mode 100644
index 0000000..f846837
--- /dev/null
+++ b/testing/jsmaker-regexp-regression.rkt
@@ -0,0 +1,24 @@
+#lang racket/base
+
+(require "../main.rkt"
+         "jsmaker-executors.rkt"
+         "jsmaker-test-framework.rkt")
+
+(define tests
+  (list
+   (js-expression-test 'regexp-literal-test (js/expression (regexp-match? #rx"a+" "baac")) "true")
+   (js-expression-test 'regexp-match-basic (js/expression (regexp-match #rx"a+" "baac")) "[\"aa\"]")
+   (js-expression-test 'regexp-match-captures (js/expression (regexp-match #rx"(a)(b)?" "a")) "[\"a\",\"a\",false]")
+   (js-expression-test 'pregexp-match-digits (js/expression (regexp-match #px"([a-z]+)-([0-9]+)" "abc-123")) "[\"abc-123\",\"abc\",\"123\"]")
+   (js-expression-test 'regexp-match-star (js/expression (regexp-match* #rx"a+" "baacaa")) "[\"aa\",\"aa\"]")
+   (js-expression-test 'regexp-split (js/expression (regexp-split #rx"," "a,b,,c")) "[\"a\",\"b\",\"\",\"c\"]")
+   (js-expression-test 'regexp-replace (js/expression (regexp-replace #rx"a" "banana" "X")) "\"bXnana\"")
+   (js-expression-test 'regexp-replace-star (js/expression (regexp-replace* #rx"a" "banana" "X")) "\"bXnXnX\"")
+   (js-expression-test 'regexp-replace-backref (js/expression (regexp-replace #rx"([a-z]+)-([0-9]+)" "abc-123" "\\2/\\1")) "\"123/abc\"")
+   (js-expression-test 'regexp-replace-full (js/expression (regexp-replace #rx"a+" "baac" "[\\0]")) "\"b[aa]c\"")
+   (js-expression-test 'regexp-pattern-string (js/expression (regexp-match "a+" "baac")) "[\"aa\"]")
+   (js-expression-test 'regexp-quote (js/expression (regexp-quote "a+b*c?")) "\"a\\\\+b\\\\*c\\\\?\"")
+   (js-expression-test 'regexp-match-positions (js/expression (regexp-match-positions #rx"(a)(b)?" "xa")) "[[1,2],[1,2],false]")))
+
+(define engine (find-js-engine))
+(run-jsmaker-regression 'jsmaker-regexp-regression tests "/tmp/jsmaker-regexp-regression.js" #:engine engine)
diff --git a/testing/jsmaker-regression.rkt b/testing/jsmaker-regression.rkt
new file mode 100644
index 0000000..bb41b73
--- /dev/null
+++ b/testing/jsmaker-regression.rkt
@@ -0,0 +1,110 @@
+#lang racket/base
+
+(require racket/string
+         "../main.rkt"
+         "jsmaker-executors.rkt"
+         "jsmaker-test-framework.rkt")
+
+(define direct-and (js/expression (and (> x 10) (< x 15))))
+(unless (string=? direct-and "((x > 10) && (x < 15))")
+  (error 'jsmaker-regression "expected direct && generation, got: ~a" direct-and))
+
+(define direct-or (js/expression (or (< x 10) (> x 20))))
+(unless (string=? direct-or "((x < 10) || (x > 20))")
+  (error 'jsmaker-regression "expected direct || generation, got: ~a" direct-or))
+
+(define direct-chain (js/expression (< x y 10)))
+(unless (string=? direct-chain "((x < y) && (y < 10))")
+  (error 'jsmaker-regression "expected direct pairwise comparison, got: ~a" direct-chain))
+
+(define effectful-chain (js/expression (< x (f y) 10)))
+(unless (regexp-match? #rx"__cmp" effectful-chain)
+  (error 'jsmaker-regression "effectful chained comparison should use temporaries, got: ~a" effectful-chain))
+
+(define simple-let-star
+  (js (let* ((x 10)
+             (y (+ x x)))
+        (return y))))
+
+(define with-handlers-rest-lambda-program
+  (js (with-handlers ([exn? (位 args (displayln args))])
+        (/ 10 0))))
+(unless (regexp-match? #rx"\\(function\\(\\.\\.\\.args\\)" with-handlers-rest-lambda-program)
+  (error 'jsmaker-regression
+         "with-handlers rest-lambda handler should be parenthesized in callee position, got: ~a"
+         with-handlers-rest-lambda-program))
+(unless (not (regexp-match? #rx"catch[^{]*\\{\\n  function\\(" with-handlers-rest-lambda-program))
+  (error 'jsmaker-regression
+         "with-handlers emitted a function declaration in statement position, got: ~a"
+         with-handlers-rest-lambda-program))
+(unless (regexp-match? #rx"let x = 10;" simple-let-star)
+  (error 'jsmaker-regression "simple let* should emit direct let for x, got: ~a" simple-let-star))
+(unless (regexp-match? #rx"let y = .*x.*x.*;" simple-let-star)
+  (error 'jsmaker-regression "simple let* should emit direct dependent let for y, got: ~a" simple-let-star))
+(unless (not (regexp-match? #rx"__let_star_value" simple-let-star))
+  (error 'jsmaker-regression "simple let* should not use tempvars, got: ~a" simple-let-star))
+
+(define tests
+  (list
+   (js-expression-test 'if-zero (js/expression (if 0 1 2)) "1")
+   (js-expression-test 'if-false (js/expression (if #f 1 2)) "2")
+   (js-expression-test 'and-false (js/expression (and #f 5)) "false")
+   (js-expression-test 'and-zero (js/expression (and 0 5)) "5")
+   (js-expression-test 'or-empty-string (js/expression (or "" 5)) "\"\"")
+   (js-expression-test 'direct-and-boolean (format "((x) => ~a)(12)" direct-and) "true")
+   (js-expression-test 'direct-or-boolean (format "((x) => ~a)(5)" direct-or) "true")
+   (js-expression-test 'chain-lt (js/expression (< 1 2 3)) "true")
+   (js-expression-test 'chain-lt-false (js/expression (< 1 3 2)) "false")
+   (js-expression-test 'let-expr (js/expression (let ([x 2] [y 3]) (+ x y))) "5")
+   (js-expression-test 'let-star-sequential-binding (js/expression (let* ([x 10] [y (+ x x)]) y)) "20")
+   (js-expression-test 'let-star-dependent-shadowing (js/expression (let ([x 4]) (let* ([x x] [y x]) (+ x y)))) "8")
+   (js-expression-test 'named-let (js/expression (let loop ([i 0] [s 0]) (if (< i 5) (loop (+ i 1) (+ s i)) s))) "10")
+   (js-expression-test 'for-list (js/expression (for/list ([x (in-range 5)] #:when (odd? x)) (* x x))) "[1,9]")
+   (js-expression-test 'for-fold (js/expression (for/fold ([s 0]) ([x (in-list (list 1 2 3))]) (+ x s))) "6")
+   (js-expression-test 'map-filter (js/expression (filter (lambda (x) (> x 2)) (map (lambda (x) (+ x 1)) (list 1 2 3)))) "[3,4]")
+   (js-expression-test 'hash-ref (js/expression (hash-ref (hash 'a 1 'b 2) 'b)) "2")
+   (js-expression-test 'substring (js/expression (substring "abcdef" 1 4)) "\"bcd\"")
+   (js-expression-test 'equal-list (js/expression (equal? (list 1 2) (list 1 2))) "true")
+   (js-expression-test 'cond-test-only (js/expression (cond [0] [else 2])) "0")
+   (js-expression-test 'cond-arrow (js/expression (cond [(+ 1 2) => (lambda (x) (+ x 10))] [else 0])) "13")
+   (js-expression-test 'cond-false-arrow (js/expression (cond [#f => (lambda (x) (+ x 10))] [else 7])) "7")
+   (js-expression-test 'rest-lambda (js/expression ((lambda xs (length xs)) 1 2 3)) "3")
+   (js-expression-test 'dotted-lambda (js/expression ((lambda (a . xs) (+ a (length xs))) 10 20 30)) "12")
+   (js-expression-test 'let-values-one (js/expression (let-values ([(x) 5]) (+ x 1))) "6")
+   (js-expression-test 'let-values-many (js/expression (let-values ([(x y) (values 2 3)]) (+ x y))) "5")
+   (js-expression-test 'let-tdz (js/expression (let ([x 4]) (let ([x x]) (+ x 1)))) "5")
+   (js-expression-test 'let-star-tdz (js/expression (let ([x 4]) (let* ([x x] [y x]) (+ x y)))) "8")
+   (js-expression-test 'division-normal
+                       (js/expression (/ 20 2 2))
+                       "5")
+   (js-expression-test 'with-handlers-division-by-zero
+                       (js/expression (with-handlers ([exn? (lambda args (string-append "caught:" (exn-message (car args))))])
+                                        (/ 10 0)))
+                       "\"caught:division by zero\"")
+   (js-expression-test 'with-handlers-generic-exn
+                       (js/expression (with-handlers ([exn? (lambda (e) (string-append "caught:" (exn-message e)))])
+                                        (error "boom")))
+                       "\"caught:boom\"")
+   (js-expression-test 'with-handlers-no-error
+                       (js/expression (with-handlers ([exn? (lambda (e) 99)])
+                                        (+ 20 22)))
+                       "42")
+   (js-expression-test 'gregor-prefix-date-string
+                       (js/expression (date->string (foo:date 2026 5 25)))
+                       "\"2026-05-25\"")
+   (js-expression-test 'gregor-prefix-time-string
+                       (js/expression (time->string (bar:time 8 9 10)))
+                       "\"08:09:10\"")
+   (js-expression-test 'gregor-prefix-moment-fields
+                       (js/expression (list (baz:->year (baz:parse-moment "2026-05-25T08:09:10" "yyyy-MM-dd'T'HH:mm:ss"))
+                                            (baz:->month (baz:parse-moment "2026-05-25T08:09:10"))
+                                            (baz:->day (baz:parse-moment "2026-05-25T08:09:10"))))
+                       "[2026,5,25]")
+   (js-expression-test 'gregor-js-date-conversion
+                       (js/expression (list (q:->year (js-date->datetime (q:->js-date (q:date 2026 5 25))))
+                                            (q:date? (q:date 2026 5 25))
+                                            (q:moment? (q:moment 2026 5 25 8 9 10))))
+                       "[2026,true,true]")))
+
+(define engine (find-js-engine))
+(run-jsmaker-regression 'jsmaker-core-regression tests "/tmp/jsmaker-core-regression.js" #:engine engine)
diff --git a/testing/jsmaker-regressions.rkt b/testing/jsmaker-regressions.rkt
new file mode 100644
index 0000000..1c37bbf
--- /dev/null
+++ b/testing/jsmaker-regressions.rkt
@@ -0,0 +1,7 @@
+#lang racket/base
+
+(require "jsmaker-regression.rkt"
+         "jsmaker-regexp-regression.rkt"
+         "jsmaker-program-regression.rkt"
+         "jsmaker-dom-exercises.rkt"
+         "jsmaker-usecases.rkt")
diff --git a/testing/jsmaker-test-framework.rkt b/testing/jsmaker-test-framework.rkt
new file mode 100644
index 0000000..7522bfd
--- /dev/null
+++ b/testing/jsmaker-test-framework.rkt
@@ -0,0 +1,88 @@
+#lang racket/base
+
+(require racket/format
+         racket/string
+         "jsmaker-executors.rkt")
+
+(provide js-expression-test
+         js-program-test
+         write-js-test-file
+         run-jsmaker-regression
+         warning-line)
+
+(define (warning-line who fmt . args)
+  (displayln (string-append "WARNING: " (apply format fmt args))
+             (current-error-port)))
+
+(define (js-expression-test name expr expected)
+  (list name expr expected))
+
+(define (js-program-test name program check-expr expected #:preamble [preamble ""])
+  (list name
+        (format "(() => {~a~a~areturn (~a); })()"
+                (if (string=? preamble "") "" (string-append "\n" preamble "\n"))
+                program
+                (if (regexp-match? #rx"\n$" program) "" "\n")
+                check-expr)
+        expected))
+
+(define (write-js-test-file js-path tests)
+  (call-with-output-file js-path
+    #:exists 'replace
+    (lambda (out)
+      (displayln "const tests = [];" out)
+      (displayln "const __normalize = (v) => v === undefined ? 'undefined' : JSON.stringify(v);" out)
+      (displayln "const __print = (...xs) => {" out)
+      (displayln "  if (typeof console !== 'undefined' && console.log) console.log(...xs);" out)
+      (displayln "  else if (typeof print === 'function') print(xs.join(' '));" out)
+      (displayln "};" out)
+      (for ([t tests])
+        (define name (symbol->string (car t)))
+        (define expr (cadr t))
+        (define expected (caddr t))
+        (fprintf out "tests.push([~s, () => (~a), ~s]);\n" name expr expected))
+      (displayln "(async () => {" out)
+      (displayln "  let failed = 0;" out)
+      (displayln "  for (const [name, thunk, expected] of tests) {" out)
+      (displayln "    let value;" out)
+      (displayln "    try { value = await Promise.resolve(thunk()); }" out)
+      (displayln "    catch (e) { value = { __thrown: String(e && e.message !== undefined ? e.message : e) }; }" out)
+      (displayln "    const actual = __normalize(value);" out)
+      (displayln "    const ok = actual === expected;" out)
+      (displayln "    __print((ok ? 'ok' : 'FAIL') + '\\t' + name + '\\t' + actual);" out)
+      (displayln "    if (!ok) failed++;" out)
+      (displayln "  }" out)
+      (displayln "  if (failed !== 0) throw new Error(failed + ' jsmaker test(s) failed');" out)
+      (displayln "})().catch((e) => {" out)
+      (displayln "  __print(e && e.stack ? e.stack : String(e));" out)
+      (displayln "  if (typeof process !== 'undefined' && process.exit) process.exit(1);" out)
+      (displayln "  throw e;" out)
+      (displayln "});" out))))
+
+(define (describe-engine engine)
+  (define version (or (js-engine-version engine) "unknown version"))
+  (format "~a at ~a (~a)"
+          (js-engine-name engine)
+          (path->string (js-engine-path engine))
+          version))
+
+(define (run-jsmaker-regression who tests js-path #:engine [engine (find-js-engine)])
+  (write-js-test-file js-path tests)
+  (cond
+    [engine
+     (printf "~a: using JavaScript engine ~a\n" who (describe-engine engine))
+     (define result (run-js-file engine js-path))
+     (display (js-run-result-stdout result))
+     (unless (string=? (js-run-result-stderr result) "")
+       (display (js-run-result-stderr result) (current-error-port)))
+     (unless (js-run-result-success? result)
+       (error who "JavaScript regression failed with ~a; see ~a"
+              (js-engine-name engine) js-path))]
+    [else
+     (warning-line who "No JavaScript engine was found; regression tests were generated but not executed.")
+     (warning-line who "Generated JavaScript test file: ~a" js-path)
+     (warning-line who "Tried engines: ~a" (string-join (map symbol->string (known-js-engine-names)) ", "))
+     (warning-line who "Set JSMAKER_ENGINE to auto/node/deno/bun/qjs/d8/jsc/js/chromium or set JSMAKER_ENGINE_PATH.")
+     (warning-line who "For backwards compatibility, JSMAKER_NODE can point to a Node executable.")
+     (when (or (getenv "JSMAKER_REQUIRE_ENGINE") (getenv "JSMAKER_REQUIRE_NODE"))
+       (error who "JavaScript engine required by environment setting"))]))
diff --git a/testing/jsmaker-test-runner.rkt b/testing/jsmaker-test-runner.rkt
new file mode 100644
index 0000000..793cc51
--- /dev/null
+++ b/testing/jsmaker-test-runner.rkt
@@ -0,0 +1,12 @@
+#lang racket/base
+
+(require "jsmaker-test-framework.rkt")
+
+(provide run-jsmaker-node-regression)
+
+;; Compatibility wrapper for the older single-engine test runner name.
+;; It now delegates to the generic framework/executor layer.  When no engine
+;; is available, the framework generates the JavaScript test file and reports a
+;; skip/warning unless JSMAKER_REQUIRE_ENGINE or JSMAKER_REQUIRE_NODE is set.
+(define (run-jsmaker-node-regression who tests js-path)
+  (run-jsmaker-regression who tests js-path))
diff --git a/testing/jsmaker-usecases.rkt b/testing/jsmaker-usecases.rkt
new file mode 100644
index 0000000..b158cdd
--- /dev/null
+++ b/testing/jsmaker-usecases.rkt
@@ -0,0 +1,191 @@
+#lang racket/base
+
+(require json
+         "../main.rkt"
+         "jsmaker-test-framework.rkt"
+         "jsmaker-executors.rkt"
+         "../demo/js-usecases.rkt")
+
+(define timer-preamble
+  #<A
" };
+const root = { innerHTML: "
A
" };
+const document = {
+  body,
+  querySelector: (selector) => selector === "body" ? body : false,
+  getElementById: (id) => id === "root" ? root : false
+};
+JS
+  )
+
+(define fetch-preamble
+  #< Promise.resolve({ title: "Done" })
+    });
+  }
+  return Promise.reject(new Error("network"));
+}
+JS
+  )
+
+(define tests
+  (list
+   (js-program-test
+    'use-random-number-1-to-5
+    usecase-random-number
+    (js/expression (randomBetween1And5))
+    (jsexpr->string 5)
+    #:preamble "Math.random = () => 0.80;")
+
+   (js-program-test
+    'use-unique-values-set
+    usecase-unique-values
+    (js/expression (uniqueValues (array 1 2 2 3 1)))
+    (jsexpr->string '(1 2 3)))
+
+   (js-program-test
+    'use-six-falsey-values
+    usecase-falsey-values
+    (js/expression (send (falseyValues) map (lambda (x) (return (Boolean x)))))
+    (jsexpr->string '(#f #f #f #f #f #f)))
+
+   (js-program-test
+    'use-currying-simple
+    usecase-currying
+    (js/expression ((add 2) 3))
+    (jsexpr->string 5))
+
+   (js-program-test
+    'use-object-destructuring
+    usecase-object-destructuring
+    (js/expression (describePerson (object 'name "Ada" 'age 37)))
+    (jsexpr->string "Ada:37"))
+
+   (js-program-test
+    'use-timer-clear-interval
+    usecase-timer-interval
+    (js/expression
+     (let* ([t (startTimer)])
+       (runInterval t.id 5)
+       (array t.id (send t getTicks) (js-dot (js-ref intervals t.id) active))))
+    (jsexpr->string '(1 3 #f))
+    #:preamble timer-preamble)
+
+   (js-program-test
+    'use-object-get-set-delete-prop
+    usecase-object-props
+    (js/expression (objectProps))
+    (jsexpr->string '(1 1 1 2 3 #f)))
+
+   (js-program-test
+    'use-string-concat-order
+    usecase-string-concat-order
+    (js/expression (concatOrder))
+    (jsexpr->string '("33" "123")))
+
+   (js-program-test
+    'use-freeze-vs-seal
+    usecase-freeze-vs-seal
+    (js/expression (freezeVsSeal))
+    (jsexpr->string '(1 9 #t #t #t)))
+
+   (js-program-test
+    'use-switch-example
+    usecase-switch
+    (js/expression (array (switchExample 1) (switchExample 2) (switchExample 9)))
+    (jsexpr->string '("one" "two-or-three" "other")))
+
+   (js-program-test
+    'use-class-constructor-default
+    usecase-class-constructor
+    (js/expression (classExample))
+    (jsexpr->string '("Hello world" "Hello Ada")))
+
+   (js-program-test
+    'use-sort-objects-by-property
+    usecase-sort-objects-by-property
+    (js/expression
+     (send (sortByProperty (array (object 'age 30) (object 'age 20) (object 'age 25)) "age")
+           map
+           (lambda (x) (return x.age))))
+    (jsexpr->string '(20 25 30)))
+
+   (js-program-test
+    'use-delete-array-elements-four-ways
+    usecase-delete-array-elements
+    (js/expression (deleteArrayWays (array "a" "b" "c")))
+    (jsexpr->string '(("a" "c") ("a" "c") ("a" "c") (#f 3))))
+
+   (js-program-test
+    'use-bubble-sort
+    usecase-bubble-sort
+    (js/expression (bubbleSort (array 5 1 4 2 8)))
+    (jsexpr->string '(1 2 4 5 8)))
+
+   (js-program-test
+    'use-binary-search-recursive
+    usecase-binary-search
+    (js/expression
+     (array (binarySearch (array 1 3 5 7 9) 7 0 4)
+            (binarySearch (array 1 3 5 7 9) 4 0 4)))
+    (jsexpr->string '(3 -1)))
+
+   (js-program-test
+    'use-map-count-occurrences
+    usecase-map-count-occurrences
+    (js/expression (countOccurrences (array "a" "b" "a" "c" "b" "a")))
+    (jsexpr->string '(("a" 3) ("b" 2) ("c" 1))))
+
+   (js-program-test
+    'use-get-html-three-ways
+    usecase-get-html-three-ways
+    (js/expression (getHtmlThreeWays))
+    (jsexpr->string '("
A
" "
A
" "
A
"))
+    #:preamble dom-preamble)
+
+   (js-program-test
+    'use-anagram
+    usecase-anagram
+    (js/expression (array (canArrange "listen" "silent")
+                          (canArrange "abc" "abd")))
+    (jsexpr->string '(#t #f)))
+
+   (js-program-test
+    'use-pairs-equal-target
+    usecase-pairs-equal-target
+    (js/expression (pairsEqualTarget (array 1 2 3 4 3 5) 6))
+    (jsexpr->string '((2 4) (3 3) (1 5))))
+
+   (js-program-test
+    'use-fetch-api-results-errors
+    usecase-fetch-api
+    (js/expression (send Promise all (array (loadTitle "/ok") (loadTitle "/fail"))))
+    "[{\"ok\":true,\"title\":\"Done\"},{\"ok\":false,\"message\":\"network\"}]"
+    #:preamble fetch-preamble)))
+
+(define engine (find-js-engine))
+(run-jsmaker-regression 'jsmaker-usecases tests "/tmp/jsmaker-usecases.js" #:engine engine)