Move DOM/browser operations to SX library wrappers (dom.sx, browser.sx) using the 8 FFI primitives, eliminating duplicate native implementations. Add scope-emitted transpiler rename — fixes 199 pre-existing test failures. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1572 lines
57 KiB
Plaintext
1572 lines
57 KiB
Plaintext
;; ==========================================================================
|
|
;; js.sx — SX-to-JavaScript translator, written in SX
|
|
;;
|
|
;; Translates (define ...) forms from .sx spec files into JavaScript source.
|
|
;; This is the self-hosting bootstrapper: the Python evaluator executes
|
|
;; this file against the spec to produce sx-ref.js — identical output to
|
|
;; the hand-written bootstrap_js.py JSEmitter.
|
|
;;
|
|
;; Usage (from SX):
|
|
;; (js-expr expr) — translate one expression to JS
|
|
;; (js-statement expr) — translate to JS statement
|
|
;; (js-translate-file defines) — translate a list of (name . define-expr) pairs
|
|
;;
|
|
;; Usage (as reader macro):
|
|
;; #js(define foo (fn (x) (+ x 1)))
|
|
;; → "var foo = function(x) { return (x + 1); };"
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; JS reserved words — names that get _ suffix
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-reserved
|
|
(list "abstract" "arguments" "boolean" "break" "byte" "case" "catch"
|
|
"char" "class" "const" "continue" "debugger" "default" "delete"
|
|
"do" "double" "else" "enum" "eval" "export" "extends" "false"
|
|
"final" "finally" "float" "for" "function" "goto" "if"
|
|
"implements" "import" "in" "instanceof" "int" "interface" "let"
|
|
"long" "native" "new" "null" "package" "private" "protected"
|
|
"public" "return" "short" "static" "super" "switch" "synchronized"
|
|
"this" "throw" "throws" "transient" "true" "try" "typeof"
|
|
"undefined" "var" "void" "volatile" "while" "with" "yield"))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; RENAMES table — explicit SX name → JS name mappings
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-renames {
|
|
:nil "NIL"
|
|
:true "true"
|
|
:false "false"
|
|
"nil?" "isNil"
|
|
"type-of" "typeOf"
|
|
"symbol-name" "symbolName"
|
|
"keyword-name" "keywordName"
|
|
"make-lambda" "makeLambda"
|
|
"make-component" "makeComponent"
|
|
"make-macro" "makeMacro"
|
|
"make-thunk" "makeThunk"
|
|
"make-handler-def" "makeHandlerDef"
|
|
"make-query-def" "makeQueryDef"
|
|
"make-action-def" "makeActionDef"
|
|
"make-page-def" "makePageDef"
|
|
"make-symbol" "makeSymbol"
|
|
"make-env" "makeEnv"
|
|
"make-sx-expr" "makeSxExpr"
|
|
"make-keyword" "makeKeyword"
|
|
"lambda-params" "lambdaParams"
|
|
"lambda-body" "lambdaBody"
|
|
"lambda-closure" "lambdaClosure"
|
|
"lambda-name" "lambdaName"
|
|
"set-lambda-name!" "setLambdaName"
|
|
"component-params" "componentParams"
|
|
"component-body" "componentBody"
|
|
"component-closure" "componentClosure"
|
|
"component-has-children?" "componentHasChildren"
|
|
"component-name" "componentName"
|
|
"component-affinity" "componentAffinity"
|
|
"macro-params" "macroParams"
|
|
"macro-rest-param" "macroRestParam"
|
|
"macro-body" "macroBody"
|
|
"macro-closure" "macroClosure"
|
|
"thunk?" "isThunk"
|
|
"thunk-expr" "thunkExpr"
|
|
"thunk-env" "thunkEnv"
|
|
"callable?" "isCallable"
|
|
"lambda?" "isLambda"
|
|
"component?" "isComponent"
|
|
"island?" "isIsland"
|
|
"make-island" "makeIsland"
|
|
"make-signal" "makeSignal"
|
|
"signal?" "isSignal"
|
|
"signal-value" "signalValue"
|
|
"signal-set-value!" "signalSetValue"
|
|
"signal-subscribers" "signalSubscribers"
|
|
"signal-add-sub!" "signalAddSub"
|
|
"signal-remove-sub!" "signalRemoveSub"
|
|
"signal-deps" "signalDeps"
|
|
"signal-set-deps!" "signalSetDeps"
|
|
"identical?" "isIdentical"
|
|
"notify-subscribers" "notifySubscribers"
|
|
"flush-subscribers" "flushSubscribers"
|
|
"dispose-computed" "disposeComputed"
|
|
"with-island-scope" "withIslandScope"
|
|
"register-in-scope" "registerInScope"
|
|
"*custom-special-forms*" "_customSpecialForms"
|
|
"register-special-form!" "registerSpecialForm"
|
|
"*render-check*" "_renderCheck"
|
|
"*render-fn*" "_renderFn"
|
|
"is-else-clause?" "isElseClause"
|
|
"host-global" "hostGlobal"
|
|
"host-get" "hostGet"
|
|
"host-set!" "hostSet"
|
|
"host-call" "hostCall"
|
|
"host-new" "hostNew"
|
|
"host-callback" "hostCallback"
|
|
"host-typeof" "hostTypeof"
|
|
"host-await" "hostAwait"
|
|
"dom-document" "domDocument"
|
|
"dom-window" "domWindow"
|
|
"dom-head" "domHead"
|
|
"!=" "notEqual_"
|
|
"<=" "lte_"
|
|
">=" "gte_"
|
|
"*batch-depth*" "_batchDepth"
|
|
"*batch-queue*" "_batchQueue"
|
|
"*store-registry*" "_storeRegistry"
|
|
"def-store" "defStore"
|
|
"use-store" "useStore"
|
|
"clear-stores" "clearStores"
|
|
"emit-event" "emitEvent"
|
|
"on-event" "onEvent"
|
|
"bridge-event" "bridgeEvent"
|
|
"macro?" "isMacro"
|
|
"primitive?" "isPrimitive"
|
|
"get-primitive" "getPrimitive"
|
|
"env-has?" "envHas"
|
|
"env-get" "envGet"
|
|
"env-bind!" "envBind"
|
|
"env-set!" "envSet"
|
|
"env-extend" "envExtend"
|
|
"env-merge" "envMerge"
|
|
"dict-set!" "dictSet"
|
|
"dict-get" "dictGet"
|
|
"eval-expr" "evalExpr"
|
|
"eval-list" "evalList"
|
|
"eval-call" "evalCall"
|
|
"is-render-expr?" "isRenderExpr"
|
|
"render-expr" "renderExpr"
|
|
"render-active?" "renderActiveP"
|
|
"set-render-active!" "setRenderActiveB"
|
|
"call-lambda" "callLambda"
|
|
"call-component" "callComponent"
|
|
"parse-keyword-args" "parseKeywordArgs"
|
|
"parse-comp-params" "parseCompParams"
|
|
"parse-macro-params" "parseMacroParams"
|
|
"expand-macro" "expandMacro"
|
|
"render-to-html" "renderToHtml"
|
|
"render-to-sx" "renderToSx"
|
|
"render-value-to-html" "renderValueToHtml"
|
|
"render-list-to-html" "renderListToHtml"
|
|
"render-html-element" "renderHtmlElement"
|
|
"render-html-component" "renderHtmlComponent"
|
|
"render-html-island" "renderHtmlIsland"
|
|
"serialize-island-state" "serializeIslandState"
|
|
"json-serialize" "jsonSerialize"
|
|
"empty-dict?" "isEmptyDict"
|
|
"parse-element-args" "parseElementArgs"
|
|
"render-attrs" "renderAttrs"
|
|
"aser-list" "aserList"
|
|
"aser-fragment" "aserFragment"
|
|
"aser-call" "aserCall"
|
|
"aser-special" "aserSpecial"
|
|
"eval-case-aser" "evalCaseAser"
|
|
"sx-serialize" "sxSerialize"
|
|
|
|
"sx-serialize-dict" "sxSerializeDict"
|
|
"sx-expr-source" "sxExprSource"
|
|
"sf-if" "sfIf"
|
|
"sf-when" "sfWhen"
|
|
"sf-cond" "sfCond"
|
|
"sf-cond-scheme" "sfCondScheme"
|
|
"sf-cond-clojure" "sfCondClojure"
|
|
"sf-case" "sfCase"
|
|
"sf-case-loop" "sfCaseLoop"
|
|
"sf-and" "sfAnd"
|
|
"sf-or" "sfOr"
|
|
"sf-let" "sfLet"
|
|
"sf-named-let" "sfNamedLet"
|
|
"sf-letrec" "sfLetrec"
|
|
"sf-dynamic-wind" "sfDynamicWind"
|
|
"push-wind!" "pushWind"
|
|
"pop-wind!" "popWind"
|
|
"call-thunk" "callThunk"
|
|
"sf-lambda" "sfLambda"
|
|
"sf-define" "sfDefine"
|
|
"sf-defcomp" "sfDefcomp"
|
|
"sf-defisland" "sfDefisland"
|
|
"defcomp-kwarg" "defcompKwarg"
|
|
"sf-defmacro" "sfDefmacro"
|
|
"sf-begin" "sfBegin"
|
|
"sf-quote" "sfQuote"
|
|
"sf-quasiquote" "sfQuasiquote"
|
|
"sf-thread-first" "sfThreadFirst"
|
|
"sf-set!" "sfSetBang"
|
|
"qq-expand" "qqExpand"
|
|
"ho-map" "hoMap"
|
|
"ho-map-indexed" "hoMapIndexed"
|
|
"ho-filter" "hoFilter"
|
|
"ho-reduce" "hoReduce"
|
|
"ho-some" "hoSome"
|
|
"ho-every" "hoEvery"
|
|
"ho-for-each" "hoForEach"
|
|
"kf-name" "kfName"
|
|
"special-form?" "isSpecialForm"
|
|
"ho-form?" "isHoForm"
|
|
"strip-prefix" "stripPrefix"
|
|
"escape-html" "escapeHtml"
|
|
"escape-attr" "escapeAttr"
|
|
"escape-string" "escapeString"
|
|
"raw-html-content" "rawHtmlContent"
|
|
"HTML_TAGS" "HTML_TAGS"
|
|
"VOID_ELEMENTS" "VOID_ELEMENTS"
|
|
"BOOLEAN_ATTRS" "BOOLEAN_ATTRS"
|
|
"definition-form?" "isDefinitionForm"
|
|
"RENDER_HTML_FORMS" "RENDER_HTML_FORMS"
|
|
"render-html-form?" "isRenderHtmlForm"
|
|
"dispatch-html-form" "dispatchHtmlForm"
|
|
"render-lambda-html" "renderLambdaHtml"
|
|
"make-raw-html" "makeRawHtml"
|
|
"SVG_NS" "SVG_NS"
|
|
"MATH_NS" "MATH_NS"
|
|
"render-to-dom" "renderToDom"
|
|
"render-dom-list" "renderDomList"
|
|
"render-dom-element" "renderDomElement"
|
|
"render-dom-component" "renderDomComponent"
|
|
"render-dom-fragment" "renderDomFragment"
|
|
"render-dom-raw" "renderDomRaw"
|
|
"render-dom-unknown-component" "renderDomUnknownComponent"
|
|
"RENDER_DOM_FORMS" "RENDER_DOM_FORMS"
|
|
"render-dom-form?" "isRenderDomForm"
|
|
"dispatch-render-form" "dispatchRenderForm"
|
|
"render-lambda-dom" "renderLambdaDom"
|
|
"render-dom-island" "renderDomIsland"
|
|
"reactive-text" "reactiveText"
|
|
"reactive-attr" "reactiveAttr"
|
|
"cek-reactive-text" "cekReactiveText"
|
|
"cek-reactive-attr" "cekReactiveAttr"
|
|
"*use-cek-reactive*" "_useCekReactive"
|
|
"enable-cek-reactive!" "enableCekReactive"
|
|
"reactive-fragment" "reactiveFragment"
|
|
"reactive-list" "reactiveList"
|
|
"dom-create-element" "domCreateElement"
|
|
"dom-append" "domAppend"
|
|
"dom-set-attr" "domSetAttr"
|
|
"dom-get-attr" "domGetAttr"
|
|
"dom-remove-attr" "domRemoveAttr"
|
|
"dom-has-attr?" "domHasAttr"
|
|
"dom-parse-html" "domParseHtml"
|
|
"dom-clone" "domClone"
|
|
"create-text-node" "createTextNode"
|
|
"create-fragment" "createFragment"
|
|
"dom-parent" "domParent"
|
|
"dom-id" "domId"
|
|
"dom-node-type" "domNodeType"
|
|
"dom-node-name" "domNodeName"
|
|
"dom-text-content" "domTextContent"
|
|
"dom-set-text-content" "domSetTextContent"
|
|
"dom-is-fragment?" "domIsFragment"
|
|
"dom-is-child-of?" "domIsChildOf"
|
|
"dom-is-active-element?" "domIsActiveElement"
|
|
"dom-is-input-element?" "domIsInputElement"
|
|
"dom-first-child" "domFirstChild"
|
|
"dom-next-sibling" "domNextSibling"
|
|
"dom-child-list" "domChildList"
|
|
"dom-attr-list" "domAttrList"
|
|
"dom-insert-before" "domInsertBefore"
|
|
"dom-insert-after" "domInsertAfter"
|
|
"dom-prepend" "domPrepend"
|
|
"dom-remove-child" "domRemoveChild"
|
|
"dom-replace-child" "domReplaceChild"
|
|
"dom-set-inner-html" "domSetInnerHtml"
|
|
"dom-insert-adjacent-html" "domInsertAdjacentHtml"
|
|
"dom-get-style" "domGetStyle"
|
|
"dom-set-style" "domSetStyle"
|
|
"dom-get-prop" "domGetProp"
|
|
"dom-set-prop" "domSetProp"
|
|
"dom-add-class" "domAddClass"
|
|
"dom-remove-class" "domRemoveClass"
|
|
"dom-dispatch" "domDispatch"
|
|
"dom-listen" "domListen"
|
|
"event-detail" "eventDetail"
|
|
"dom-query" "domQuery"
|
|
"dom-ensure-element" "domEnsureElement"
|
|
"dom-query-all" "domQueryAll"
|
|
"dom-tag-name" "domTagName"
|
|
"create-comment" "createComment"
|
|
"dom-remove" "domRemove"
|
|
"dom-child-nodes" "domChildNodes"
|
|
"dom-remove-children-after" "domRemoveChildrenAfter"
|
|
"dom-set-data" "domSetData"
|
|
"dom-get-data" "domGetData"
|
|
"json-parse" "jsonParse"
|
|
"dict-has?" "dictHas"
|
|
"has-key?" "dictHas"
|
|
"dict-delete!" "dictDelete"
|
|
"process-bindings" "processBindings"
|
|
"eval-cond" "evalCond"
|
|
"eval-cond-scheme" "evalCondScheme"
|
|
"eval-cond-clojure" "evalCondClojure"
|
|
"for-each-indexed" "forEachIndexed"
|
|
"index-of" "indexOf_"
|
|
"ENGINE_VERBS" "ENGINE_VERBS"
|
|
"DEFAULT_SWAP" "DEFAULT_SWAP"
|
|
"parse-time" "parseTime"
|
|
"parse-trigger-spec" "parseTriggerSpec"
|
|
"default-trigger" "defaultTrigger"
|
|
"get-verb-info" "getVerbInfo"
|
|
"build-request-headers" "buildRequestHeaders"
|
|
"process-response-headers" "processResponseHeaders"
|
|
"parse-swap-spec" "parseSwapSpec"
|
|
"parse-retry-spec" "parseRetrySpec"
|
|
"next-retry-ms" "nextRetryMs"
|
|
"filter-params" "filterParams"
|
|
"resolve-target" "resolveTarget"
|
|
"apply-optimistic" "applyOptimistic"
|
|
"revert-optimistic" "revertOptimistic"
|
|
"find-oob-swaps" "findOobSwaps"
|
|
"morph-node" "morphNode"
|
|
"sync-attrs" "syncAttrs"
|
|
"morph-children" "morphChildren"
|
|
"swap-dom-nodes" "swapDomNodes"
|
|
"insert-remaining-siblings" "insertRemainingSiblings"
|
|
"swap-html-string" "swapHtmlString"
|
|
"handle-history" "handleHistory"
|
|
"PRELOAD_TTL" "PRELOAD_TTL"
|
|
"preload-cache-get" "preloadCacheGet"
|
|
"preload-cache-set" "preloadCacheSet"
|
|
"classify-trigger" "classifyTrigger"
|
|
"should-boost-link?" "shouldBoostLink"
|
|
"should-boost-form?" "shouldBoostForm"
|
|
"parse-sse-swap" "parseSseSwap"
|
|
"_preload-cache" "_preloadCache"
|
|
"_css-hash" "_cssHash"
|
|
"dispatch-trigger-events" "dispatchTriggerEvents"
|
|
"init-css-tracking" "initCssTracking"
|
|
"execute-request" "executeRequest"
|
|
"do-fetch" "doFetch"
|
|
"handle-fetch-success" "handleFetchSuccess"
|
|
"handle-sx-response" "handleSxResponse"
|
|
"handle-html-response" "handleHtmlResponse"
|
|
"handle-retry" "handleRetry"
|
|
"bind-triggers" "bindTriggers"
|
|
"bind-event" "bindEvent"
|
|
"post-swap" "postSwap"
|
|
"activate-scripts" "activateScripts"
|
|
"process-oob-swaps" "processOobSwaps"
|
|
"hoist-head-elements" "hoistHeadElements"
|
|
"process-boosted" "processBoosted"
|
|
"boost-descendants" "boostDescendants"
|
|
"process-sse" "processSse"
|
|
"bind-sse" "bindSse"
|
|
"bind-sse-swap" "bindSseSwap"
|
|
"bind-inline-handlers" "bindInlineHandlers"
|
|
"process-emit-elements" "processEmitElements"
|
|
"bind-preload-for" "bindPreloadFor"
|
|
"do-preload" "doPreload"
|
|
"VERB_SELECTOR" "VERB_SELECTOR"
|
|
"process-elements" "processElements"
|
|
"process-one" "processOne"
|
|
"handle-popstate" "handlePopstate"
|
|
"engine-init" "engineInit"
|
|
"promise-resolve" "promiseResolve"
|
|
"promise-then" "promiseThen"
|
|
"promise-catch" "promiseCatch"
|
|
"promise-delayed" "promiseDelayed"
|
|
"abort-previous" "abortPrevious"
|
|
"track-controller" "trackController"
|
|
"abort-previous-target" "abortPreviousTarget"
|
|
"track-controller-target" "trackControllerTarget"
|
|
"new-abort-controller" "newAbortController"
|
|
"controller-signal" "controllerSignal"
|
|
"abort-error?" "isAbortError"
|
|
"set-timeout" "setTimeout_"
|
|
"set-interval" "setInterval_"
|
|
"clear-timeout" "clearTimeout_"
|
|
"clear-interval" "clearInterval_"
|
|
"request-animation-frame" "requestAnimationFrame_"
|
|
"csrf-token" "csrfToken"
|
|
"cross-origin?" "isCrossOrigin"
|
|
"loaded-component-names" "loadedComponentNames"
|
|
"build-request-body" "buildRequestBody"
|
|
"show-indicator" "showIndicator"
|
|
"disable-elements" "disableElements"
|
|
"clear-loading-state" "clearLoadingState"
|
|
"fetch-request" "fetchRequest"
|
|
"fetch-location" "fetchLocation"
|
|
"fetch-and-restore" "fetchAndRestore"
|
|
"fetch-streaming" "fetchStreaming"
|
|
"fetch-preload" "fetchPreload"
|
|
"dom-query-by-id" "domQueryById"
|
|
"dom-matches?" "domMatches"
|
|
"dom-closest" "domClosest"
|
|
"dom-body" "domBody"
|
|
"dom-has-class?" "domHasClass"
|
|
"dom-append-to-head" "domAppendToHead"
|
|
"dom-parse-html-document" "domParseHtmlDocument"
|
|
"dom-outer-html" "domOuterHtml"
|
|
"dom-body-inner-html" "domBodyInnerHtml"
|
|
"prevent-default" "preventDefault_"
|
|
"stop-propagation" "stopPropagation_"
|
|
"dom-focus" "domFocus"
|
|
"try-catch" "tryCatch"
|
|
"error-message" "errorMessage"
|
|
"schedule-idle" "scheduleIdle"
|
|
"element-value" "elementValue"
|
|
"validate-for-request" "validateForRequest"
|
|
"with-transition" "withTransition"
|
|
"observe-intersection" "observeIntersection"
|
|
"event-source-connect" "eventSourceConnect"
|
|
"event-source-listen" "eventSourceListen"
|
|
"bind-boost-link" "bindBoostLink"
|
|
"bind-boost-form" "bindBoostForm"
|
|
"bind-client-route-link" "bindClientRouteLink"
|
|
"bind-client-route-click" "bindClientRouteClick"
|
|
"try-client-route" "tryClientRoute"
|
|
"try-eval-content" "tryEvalContent"
|
|
"try-async-eval-content" "tryAsyncEvalContent"
|
|
"register-io-deps" "registerIoDeps"
|
|
"url-pathname" "urlPathname"
|
|
"bind-preload" "bindPreload"
|
|
"mark-processed!" "markProcessed"
|
|
"is-processed?" "isProcessed"
|
|
"clear-processed!" "clearProcessed"
|
|
"create-script-clone" "createScriptClone"
|
|
"sx-render" "sxRender"
|
|
"sx-process-scripts" "sxProcessScripts"
|
|
"sx-hydrate" "sxHydrate"
|
|
"strip-component-scripts" "stripComponentScripts"
|
|
"extract-response-css" "extractResponseCss"
|
|
"select-from-container" "selectFromContainer"
|
|
"children-to-fragment" "childrenToFragment"
|
|
"select-html-from-doc" "selectHtmlFromDoc"
|
|
"try-parse-json" "tryParseJson"
|
|
"process-css-response" "processCssResponse"
|
|
"browser-location-href" "browserLocationHref"
|
|
"browser-same-origin?" "browserSameOrigin"
|
|
"browser-push-state" "browserPushState"
|
|
"browser-replace-state" "browserReplaceState"
|
|
"browser-navigate" "browserNavigate"
|
|
"browser-reload" "browserReload"
|
|
"browser-scroll-to" "browserScrollTo"
|
|
"browser-media-matches?" "browserMediaMatches"
|
|
"browser-confirm" "browserConfirm"
|
|
"browser-prompt" "browserPrompt"
|
|
"now-ms" "nowMs"
|
|
"parse-header-value" "parseHeaderValue"
|
|
"replace" "replace_"
|
|
"whitespace?" "isWhitespace"
|
|
"digit?" "isDigit"
|
|
"ident-start?" "isIdentStart"
|
|
"ident-char?" "isIdentChar"
|
|
"parse-number" "parseNumber"
|
|
"starts-with?" "startsWith"
|
|
"ends-with?" "endsWith"
|
|
"contains?" "contains"
|
|
"empty?" "isEmpty"
|
|
"odd?" "isOdd"
|
|
"even?" "isEven"
|
|
"zero?" "isZero"
|
|
"number?" "isNumber"
|
|
"string?" "isString"
|
|
"list?" "isList"
|
|
"dict?" "isDict"
|
|
"every?" "isEvery"
|
|
"map-indexed" "mapIndexed"
|
|
"for-each" "forEach"
|
|
"map-dict" "mapDict"
|
|
"chunk-every" "chunkEvery"
|
|
"zip-pairs" "zipPairs"
|
|
"strip-tags" "stripTags"
|
|
"format-date" "formatDate"
|
|
"format-decimal" "formatDecimal"
|
|
"parse-int" "parseInt_"
|
|
"HEAD_HOIST_SELECTOR" "HEAD_HOIST_SELECTOR"
|
|
"hoist-head-elements-full" "hoistHeadElementsFull"
|
|
"sx-mount" "sxMount"
|
|
"sx-hydrate-elements" "sxHydrateElements"
|
|
"sx-update-element" "sxUpdateElement"
|
|
"sx-render-component" "sxRenderComponent"
|
|
"process-sx-scripts" "processSxScripts"
|
|
"process-component-script" "processComponentScript"
|
|
"SX_VERSION" "SX_VERSION"
|
|
"boot-init" "bootInit"
|
|
"sx-hydrate-islands" "sxHydrateIslands"
|
|
"hydrate-island" "hydrateIsland"
|
|
"dispose-island" "disposeIsland"
|
|
"resolve-suspense" "resolveSuspense"
|
|
"resolve-mount-target" "resolveMountTarget"
|
|
"sx-render-with-env" "sxRenderWithEnv"
|
|
"get-render-env" "getRenderEnv"
|
|
"merge-envs" "mergeEnvs"
|
|
"sx-load-components" "sxLoadComponents"
|
|
"set-document-title" "setDocumentTitle"
|
|
"remove-head-element" "removeHeadElement"
|
|
"query-sx-scripts" "querySxScripts"
|
|
"local-storage-get" "localStorageGet"
|
|
"local-storage-set" "localStorageSet"
|
|
"local-storage-remove" "localStorageRemove"
|
|
"set-sx-comp-cookie" "setSxCompCookie"
|
|
"clear-sx-comp-cookie" "clearSxCompCookie"
|
|
"parse-env-attr" "parseEnvAttr"
|
|
"store-env-attr" "storeEnvAttr"
|
|
"to-kebab" "toKebab"
|
|
"log-info" "logInfo"
|
|
"log-warn" "logWarn"
|
|
"log-parse-error" "logParseError"
|
|
"_page-routes" "_pageRoutes"
|
|
"process-page-scripts" "processPageScripts"
|
|
"query-page-scripts" "queryPageScripts"
|
|
"scan-refs" "scanRefs"
|
|
"scan-refs-walk" "scanRefsWalk"
|
|
"transitive-deps" "transitiveDeps"
|
|
"compute-all-deps" "computeAllDeps"
|
|
"scan-components-from-source" "scanComponentsFromSource"
|
|
"components-needed" "componentsNeeded"
|
|
"page-component-bundle" "pageComponentBundle"
|
|
"page-css-classes" "pageCssClasses"
|
|
"component-deps" "componentDeps"
|
|
"component-set-deps!" "componentSetDeps"
|
|
"component-css-classes" "componentCssClasses"
|
|
"component-io-refs" "componentIoRefs"
|
|
"component-set-io-refs!" "componentSetIoRefs"
|
|
"env-components" "envComponents"
|
|
"regex-find-all" "regexFindAll"
|
|
"scan-css-classes" "scanCssClasses"
|
|
"scan-io-refs" "scanIoRefs"
|
|
"scan-io-refs-walk" "scanIoRefsWalk"
|
|
"transitive-io-refs" "transitiveIoRefs"
|
|
"compute-all-io-refs" "computeAllIoRefs"
|
|
"component-io-refs-cached" "componentIoRefsCached"
|
|
"component-pure?" "componentPure_p"
|
|
"render-target" "renderTarget"
|
|
"page-render-plan" "pageRenderPlan"
|
|
"split-path-segments" "splitPathSegments"
|
|
"make-route-segment" "makeRouteSegment"
|
|
"parse-route-pattern" "parseRoutePattern"
|
|
"match-route-segments" "matchRouteSegments"
|
|
"match-route" "matchRoute"
|
|
"find-matching-route" "findMatchingRoute"
|
|
"make-spread" "makeSpread"
|
|
"spread?" "isSpread"
|
|
"spread-attrs" "spreadAttrs"
|
|
"merge-spread-attrs" "mergeSpreadAttrs"
|
|
"collect!" "sxCollect"
|
|
"collected" "sxCollected"
|
|
"clear-collected!" "sxClearCollected"
|
|
"make-cek-continuation" "makeCekContinuation"
|
|
"continuation-data" "continuationData"
|
|
"make-cek-state" "makeCekState"
|
|
"make-cek-value" "makeCekValue"
|
|
"cek-terminal?" "cekTerminal_p"
|
|
"cek-run" "cekRun"
|
|
"cek-step" "cekStep"
|
|
"cek-control" "cekControl"
|
|
"cek-env" "cekEnv"
|
|
"cek-kont" "cekKont"
|
|
"cek-phase" "cekPhase"
|
|
"cek-value" "cekValue"
|
|
"kont-push" "kontPush"
|
|
"kont-top" "kontTop"
|
|
"kont-pop" "kontPop"
|
|
"kont-empty?" "kontEmpty_p"
|
|
"kont-capture-to-reset" "kontCaptureToReset"
|
|
"kont-capture-to-reactive-reset" "kontCaptureToReactiveReset"
|
|
"has-reactive-reset-frame?" "hasReactiveResetFrame_p"
|
|
"frame-type" "frameType"
|
|
"make-if-frame" "makeIfFrame"
|
|
"make-when-frame" "makeWhenFrame"
|
|
"make-begin-frame" "makeBeginFrame"
|
|
"make-let-frame" "makeLetFrame"
|
|
"make-define-frame" "makeDefineFrame"
|
|
"make-set-frame" "makeSetFrame"
|
|
"make-arg-frame" "makeArgFrame"
|
|
"make-call-frame" "makeCallFrame"
|
|
"make-cond-frame" "makeCondFrame"
|
|
"make-case-frame" "makeCaseFrame"
|
|
"make-thread-frame" "makeThreadFrame"
|
|
"make-map-frame" "makeMapFrame"
|
|
"make-filter-frame" "makeFilterFrame"
|
|
"make-reduce-frame" "makeReduceFrame"
|
|
"make-for-each-frame" "makeForEachFrame"
|
|
"make-scope-frame" "makeScopeFrame"
|
|
"make-reset-frame" "makeResetFrame"
|
|
"make-dict-frame" "makeDictFrame"
|
|
"make-and-frame" "makeAndFrame"
|
|
"make-or-frame" "makeOrFrame"
|
|
"make-dynamic-wind-frame" "makeDynamicWindFrame"
|
|
"make-reactive-reset-frame" "makeReactiveResetFrame"
|
|
"make-deref-frame" "makeDerefFrame"
|
|
"step-eval" "stepEval"
|
|
"step-continue" "stepContinue"
|
|
"step-eval-list" "stepEvalList"
|
|
"step-eval-call" "stepEvalCall"
|
|
"step-sf-if" "stepSfIf"
|
|
"step-sf-when" "stepSfWhen"
|
|
"step-sf-begin" "stepSfBegin"
|
|
"step-sf-let" "stepSfLet"
|
|
"step-sf-define" "stepSfDefine"
|
|
"step-sf-set!" "stepSfSet"
|
|
"step-sf-and" "stepSfAnd"
|
|
"step-sf-or" "stepSfOr"
|
|
"step-sf-cond" "stepSfCond"
|
|
"step-sf-case" "stepSfCase"
|
|
"step-sf-thread-first" "stepSfThreadFirst"
|
|
"step-sf-lambda" "stepSfLambda"
|
|
"step-sf-scope" "stepSfScope"
|
|
"step-sf-provide" "stepSfProvide"
|
|
"step-sf-reset" "stepSfReset"
|
|
"step-sf-shift" "stepSfShift"
|
|
"step-sf-deref" "stepSfDeref"
|
|
"step-ho-map" "stepHoMap"
|
|
"step-ho-filter" "stepHoFilter"
|
|
"step-ho-reduce" "stepHoReduce"
|
|
"step-ho-for-each" "stepHoForEach"
|
|
"continue-with-call" "continueWithCall"
|
|
"sf-case-step-loop" "sfCaseStepLoop"
|
|
"eval-expr-cek" "evalExprCek"
|
|
"trampoline-cek" "trampolineCek"
|
|
"reactive-shift-deref" "reactiveShiftDeref"
|
|
"cond-scheme?" "condScheme_p"
|
|
"scope-push!" "scopePush"
|
|
"scope-pop!" "scopePop"
|
|
"scope-emit!" "scopeEmit"
|
|
"scope-emitted" "sxEmitted"
|
|
"scope-peek" "scopePeek"
|
|
"provide-push!" "providePush"
|
|
"provide-pop!" "providePop"
|
|
"context" "sxContext"
|
|
"emit!" "sxEmit"
|
|
"emitted" "sxEmitted"
|
|
})
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Name mangling: SX identifier → valid JS identifier (camelCase)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-mangle
|
|
(fn ((name :as string))
|
|
(let ((renamed (get js-renames name)))
|
|
(if (not (nil? renamed))
|
|
renamed
|
|
;; General mangling rules
|
|
(let ((result (replace name "*" "_")))
|
|
;; Handle trailing ? and !
|
|
(let ((result (cond
|
|
(ends-with? result "?")
|
|
(str (slice result 0 (- (string-length result) 1)) "_p")
|
|
(ends-with? result "!")
|
|
(str (slice result 0 (- (string-length result) 1)) "_b")
|
|
:else result)))
|
|
;; Kebab to camelCase
|
|
(let ((result (js-kebab-to-camel result)))
|
|
;; Escape JS reserved words
|
|
(if (some (fn (r) (= r result)) js-reserved)
|
|
(str result "_")
|
|
result))))))))
|
|
|
|
(define js-kebab-to-camel
|
|
(fn ((s :as string))
|
|
(let ((parts (split s "-")))
|
|
(if (<= (len parts) 1)
|
|
s
|
|
(str (first parts)
|
|
(join "" (map (fn (p) (js-capitalize p)) (rest parts))))))))
|
|
|
|
(define js-capitalize
|
|
(fn ((s :as string))
|
|
(if (empty? s) s
|
|
(str (upper (slice s 0 1)) (slice s 1)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; String quoting for JavaScript
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-quote-string
|
|
(fn ((s :as string))
|
|
(str "\""
|
|
(replace (replace (replace (replace (replace (replace
|
|
s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") "\r" "\\r") "\t" "\\t") (char-from-code 0) "\\u0000")
|
|
"\"")))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Infix operators
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-infix-ops
|
|
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
|
|
|
|
(define js-infix?
|
|
(fn ((op :as string))
|
|
(some (fn (x) (= x op)) js-infix-ops)))
|
|
|
|
(define js-op-symbol
|
|
(fn ((op :as string))
|
|
(case op
|
|
"=" "=="
|
|
"!=" "!="
|
|
"mod" "%"
|
|
:else op)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Self-tail-recursion detection
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-is-self-tail-recursive?
|
|
(fn ((name :as string) (body :as list))
|
|
(if (empty? body)
|
|
false
|
|
(js-has-tail-call? name (last body)))))
|
|
|
|
(define js-has-tail-call?
|
|
(fn ((name :as string) expr)
|
|
(if (not (and (list? expr) (not (empty? expr))))
|
|
false
|
|
(let ((head (first expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
false
|
|
(let ((h (symbol-name head)))
|
|
(cond
|
|
;; Direct tail call
|
|
(= h name) true
|
|
;; Branching forms
|
|
(= h "if")
|
|
(or (js-has-tail-call? name (nth expr 2))
|
|
(and (>= (len expr) 4)
|
|
(js-has-tail-call? name (nth expr 3))))
|
|
(= h "when")
|
|
(some (fn (e) (js-has-tail-call? name e)) (rest (rest expr)))
|
|
(= h "cond")
|
|
(some (fn (clause)
|
|
(if (and (list? clause) (= (len clause) 2))
|
|
(js-has-tail-call? name (nth clause 1))
|
|
(if (= (type-of clause) "keyword")
|
|
false
|
|
(js-has-tail-call? name clause))))
|
|
(rest expr))
|
|
(or (= h "do") (= h "begin"))
|
|
(if (> (len expr) 1) (js-has-tail-call? name (last expr)) false)
|
|
(or (= h "let") (= h "let*"))
|
|
(if (> (len expr) 2) (js-has-tail-call? name (last expr)) false)
|
|
:else false)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Tail-as-statement emission (for while loop bodies)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-tail-as-stmt
|
|
(fn ((name :as string) expr)
|
|
(if (not (and (list? expr) (not (empty? expr))))
|
|
(str "return " (js-expr expr) ";")
|
|
(let ((head (first expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
(str "return " (js-expr expr) ";")
|
|
(let ((h (symbol-name head)))
|
|
(cond
|
|
;; Direct tail call to self → continue
|
|
(= h name)
|
|
"continue;"
|
|
;; (do/begin stmt1 ... tail) → emit stmts then recurse on tail
|
|
(or (= h "do") (= h "begin"))
|
|
(str (join "\n" (map (fn (e) (js-statement e)) (slice expr 1 (- (len expr) 1))))
|
|
"\n" (js-emit-tail-as-stmt name (last expr)))
|
|
;; (if cond then else)
|
|
(= h "if")
|
|
(str "if (isSxTruthy(" (js-expr (nth expr 1))
|
|
")) { " (js-emit-tail-as-stmt name (nth expr 2))
|
|
" } else { " (if (>= (len expr) 4)
|
|
(js-emit-tail-as-stmt name (nth expr 3))
|
|
"return NIL;")
|
|
" }")
|
|
;; (when cond body...)
|
|
(= h "when")
|
|
(let ((body-parts (rest (rest expr))))
|
|
(str "if (isSxTruthy(" (js-expr (nth expr 1))
|
|
")) { " (if (empty? body-parts) ""
|
|
(str (join "\n" (map (fn (e) (js-statement e))
|
|
(slice body-parts 0 (- (len body-parts) 1))))
|
|
(if (> (len body-parts) 1) "\n" "")
|
|
(js-emit-tail-as-stmt name (last body-parts))))
|
|
" } else { return NIL; }"))
|
|
;; (cond ...)
|
|
(= h "cond")
|
|
(js-emit-cond-as-loop-stmt name (rest expr))
|
|
;; (let bindings body...)
|
|
(or (= h "let") (= h "let*"))
|
|
(let ((bindings (nth expr 1))
|
|
(body (rest (rest expr)))
|
|
(parts (list)))
|
|
(begin
|
|
;; Emit bindings as var declarations
|
|
(js-append-let-binding-parts bindings parts)
|
|
;; Emit body[:-1] as statements
|
|
(for-each (fn (e) (append! parts (js-statement e)))
|
|
(slice body 0 (- (len body) 1)))
|
|
;; Emit tail
|
|
(append! parts (js-emit-tail-as-stmt name (last body)))
|
|
(str "{ " (join "\n" parts) " }")))
|
|
;; Not a tail call
|
|
:else
|
|
(str "return " (js-expr expr) ";"))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Cond as loop statement (if/else if/else for while loop body)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-cond-as-loop-stmt
|
|
(fn ((name :as string) (clauses :as list))
|
|
(if (empty? clauses)
|
|
"return NIL;"
|
|
;; Detect scheme vs clojure
|
|
(let ((is-scheme (and
|
|
(every? (fn (c) (and (list? c) (= (len c) 2))) clauses)
|
|
(not (some (fn (c) (= (type-of c) "keyword")) clauses)))))
|
|
(if is-scheme
|
|
(js-cond-scheme-loop name clauses 0)
|
|
(js-cond-clojure-loop name clauses 0 0 false))))))
|
|
|
|
(define js-cond-scheme-loop
|
|
(fn ((name :as string) (clauses :as list) (i :as number))
|
|
(if (>= i (len clauses))
|
|
"else { return NIL; }"
|
|
(let ((clause (nth clauses i))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(if (js-is-else? test)
|
|
(str "{ " (js-emit-tail-as-stmt name body) " }")
|
|
(str (if (= i 0) "if" " else if")
|
|
" (isSxTruthy(" (js-expr test) ")) { "
|
|
(js-emit-tail-as-stmt name body) " }"
|
|
(js-cond-scheme-loop name clauses (+ i 1))))))))
|
|
|
|
(define js-cond-clojure-loop
|
|
(fn ((name :as string) (clauses :as list) (i :as number) (clause-idx :as number) (has-else :as boolean))
|
|
(if (>= i (len clauses))
|
|
(if has-else "" " else { return NIL; }")
|
|
(let ((c (nth clauses i)))
|
|
(if (and (= (type-of c) "keyword") (= (keyword-name c) "else"))
|
|
(if (< (+ i 1) (len clauses))
|
|
(str " else { " (js-emit-tail-as-stmt name (nth clauses (+ i 1))) " }")
|
|
"")
|
|
(if (< (+ i 1) (len clauses))
|
|
(str (if (= clause-idx 0) "if" " else if")
|
|
" (isSxTruthy(" (js-expr c) ")) { "
|
|
(js-emit-tail-as-stmt name (nth clauses (+ i 1)))
|
|
" }" (js-cond-clojure-loop name clauses (+ i 2) (+ clause-idx 1) has-else))
|
|
(str " else { " (js-emit-tail-as-stmt name c) " }")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Loop body emission (for self-tail-recursive while loops)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-loop-body
|
|
(fn ((name :as string) (body :as list))
|
|
(if (empty? body)
|
|
"return NIL;"
|
|
(str (join "\n" (map (fn (e) (js-statement e))
|
|
(slice body 0 (- (len body) 1))))
|
|
(if (> (len body) 1) "\n" "")
|
|
(js-emit-tail-as-stmt name (last body))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Expression translator: SX AST → JS expression string
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-expr
|
|
(fn (expr)
|
|
(cond
|
|
;; Bool MUST come before number check
|
|
(= (type-of expr) "boolean")
|
|
(if expr "true" "false")
|
|
|
|
;; Nil
|
|
(nil? expr) "NIL"
|
|
|
|
;; Numbers
|
|
(number? expr) (str expr)
|
|
|
|
;; Strings
|
|
(string? expr) (js-quote-string expr)
|
|
|
|
;; Symbols
|
|
(= (type-of expr) "symbol")
|
|
(js-mangle (symbol-name expr))
|
|
|
|
;; Keywords → string
|
|
(= (type-of expr) "keyword")
|
|
(js-quote-string (keyword-name expr))
|
|
|
|
;; Dicts (native {:key val} syntax)
|
|
(= (type-of expr) "dict")
|
|
(js-emit-native-dict expr)
|
|
|
|
;; Lists (function calls / special forms)
|
|
(list? expr)
|
|
(if (empty? expr)
|
|
"[]"
|
|
(js-emit-list expr))
|
|
|
|
;; Fallback
|
|
:else (str expr))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Dict emission
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-native-dict
|
|
(fn ((d :as dict))
|
|
(let ((items (keys d)))
|
|
(str "{" (join ", " (map (fn (k)
|
|
(str (js-quote-string k) ": " (js-expr (get d k))))
|
|
items)) "}"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; List/call emission — the main dispatch
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-list
|
|
(fn (expr)
|
|
(let ((head (first expr))
|
|
(args (rest expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
;; Data list — not a function call
|
|
(str "[" (join ", " (map js-expr expr)) "]")
|
|
(let ((op (symbol-name head)))
|
|
(cond
|
|
;; fn/lambda
|
|
(or (= op "fn") (= op "lambda"))
|
|
(js-emit-fn expr)
|
|
|
|
;; let/let*
|
|
(or (= op "let") (= op "let*"))
|
|
(js-emit-let expr)
|
|
|
|
;; if
|
|
(= op "if")
|
|
(let ((cond-e (js-expr (nth args 0)))
|
|
(then-e (js-expr (nth args 1)))
|
|
(else-e (if (>= (len args) 3)
|
|
(js-expr (nth args 2))
|
|
"NIL")))
|
|
(str "(isSxTruthy(" cond-e ") ? " then-e " : " else-e ")"))
|
|
|
|
;; when
|
|
(= op "when")
|
|
(js-emit-when expr)
|
|
|
|
;; cond
|
|
(= op "cond")
|
|
(js-emit-cond args)
|
|
|
|
;; case
|
|
(= op "case")
|
|
(js-emit-case args)
|
|
|
|
;; and
|
|
(= op "and")
|
|
(js-emit-and args)
|
|
|
|
;; or
|
|
(= op "or")
|
|
(js-emit-or args)
|
|
|
|
;; not
|
|
(= op "not")
|
|
(str "!isSxTruthy(" (js-expr (first args)) ")")
|
|
|
|
;; do/begin → comma operator
|
|
(or (= op "do") (= op "begin"))
|
|
(js-emit-do args)
|
|
|
|
;; list literal
|
|
(= op "list")
|
|
(str "[" (join ", " (map js-expr args)) "]")
|
|
|
|
;; dict literal
|
|
(= op "dict")
|
|
(js-emit-dict-literal args)
|
|
|
|
;; quote
|
|
(= op "quote")
|
|
(js-emit-quote (first args))
|
|
|
|
;; set! → direct assignment (JS closures capture by reference)
|
|
(= op "set!")
|
|
(str "(" (js-mangle (symbol-name (first args))) " = "
|
|
(js-expr (nth args 1)) ")")
|
|
|
|
;; str → String() concatenation
|
|
(= op "str")
|
|
(if (empty? args)
|
|
"\"\""
|
|
(str "(" (join " + " (map (fn (x) (str "String(" (js-expr x) ")"))
|
|
args)) ")"))
|
|
|
|
;; Mutation forms
|
|
(= op "append!")
|
|
(str "append_b(" (js-expr (nth args 0))
|
|
", " (js-expr (nth args 1)) ")")
|
|
|
|
(= op "dict-set!")
|
|
(str "dictSet(" (js-expr (nth args 0))
|
|
", " (js-expr (nth args 1))
|
|
", " (js-expr (nth args 2)) ")")
|
|
|
|
(= op "env-bind!")
|
|
(str "envBind(" (js-expr (nth args 0))
|
|
", " (js-expr (nth args 1))
|
|
", " (js-expr (nth args 2)) ")")
|
|
|
|
(= op "env-set!")
|
|
(str "envSet(" (js-expr (nth args 0))
|
|
", " (js-expr (nth args 1))
|
|
", " (js-expr (nth args 2)) ")")
|
|
|
|
(= op "set-lambda-name!")
|
|
(str "setLambdaName(" (js-expr (nth args 0))
|
|
", " (js-expr (nth args 1)) ")")
|
|
|
|
;; Infix operators
|
|
(js-infix? op)
|
|
(js-emit-infix op args)
|
|
|
|
;; inc/dec
|
|
(= op "inc")
|
|
(str "(" (js-expr (first args)) " + 1)")
|
|
(= op "dec")
|
|
(str "(" (js-expr (first args)) " - 1)")
|
|
|
|
;; Regular function call
|
|
:else
|
|
(str (js-mangle op) "("
|
|
(join ", " (map js-expr args))
|
|
")")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; fn/lambda → function() { return ...; }
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-fn
|
|
(fn (expr)
|
|
(let ((params (nth expr 1))
|
|
(body (rest (rest expr)))
|
|
(param-info (js-collect-params params)))
|
|
(let ((param-strs (first param-info))
|
|
(rest-name (nth param-info 1))
|
|
(params-str (join ", " param-strs)))
|
|
(let ((rest-preamble (if (nil? rest-name)
|
|
""
|
|
(str "var " rest-name " = Array.prototype.slice.call(arguments, "
|
|
(str (len param-strs)) "); "))))
|
|
(if (= (len body) 1)
|
|
;; Single expression body
|
|
(let ((body-js (js-expr (first body))))
|
|
(if (not (= rest-preamble ""))
|
|
(str "function(" params-str ") { " rest-preamble "return " body-js "; }")
|
|
(str "function(" params-str ") { return " body-js "; }")))
|
|
;; Multi-expression body: statements then return last
|
|
(let ((parts (list)))
|
|
(begin
|
|
(when (not (= rest-preamble ""))
|
|
(append! parts (slice rest-preamble 0 (- (string-length rest-preamble) 1))))
|
|
(for-each (fn (b) (append! parts (js-statement b)))
|
|
(slice body 0 (- (len body) 1)))
|
|
(append! parts (str "return " (js-expr (last body)) ";"))
|
|
(str "function(" params-str ") { " (join "\n" parts) " }")))))))))
|
|
|
|
(define js-collect-params
|
|
(fn ((params :as list))
|
|
(js-collect-params-loop params 0 (list) nil)))
|
|
|
|
(define js-collect-params-loop
|
|
(fn ((params :as list) (i :as number) (result :as list) rest-name)
|
|
(if (>= i (len params))
|
|
(list result rest-name)
|
|
(let ((p (nth params i)))
|
|
(cond
|
|
;; &rest marker
|
|
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
|
|
(if (< (+ i 1) (len params))
|
|
(let ((rp (nth params (+ i 1))))
|
|
(js-collect-params-loop params (+ i 2) result
|
|
(js-mangle
|
|
(if (and (= (type-of rp) "list") (= (len rp) 3)
|
|
(= (type-of (nth rp 1)) "keyword")
|
|
(= (keyword-name (nth rp 1)) "as"))
|
|
(symbol-name (first rp))
|
|
(if (= (type-of rp) "symbol") (symbol-name rp) (str rp))))))
|
|
(js-collect-params-loop params (+ i 1) result rest-name))
|
|
;; Normal param
|
|
(= (type-of p) "symbol")
|
|
(js-collect-params-loop params (+ i 1)
|
|
(append result (js-mangle (symbol-name p))) rest-name)
|
|
;; Annotated param: (name :as type) → extract name
|
|
(and (= (type-of p) "list") (= (len p) 3)
|
|
(= (type-of (nth p 1)) "keyword")
|
|
(= (keyword-name (nth p 1)) "as"))
|
|
(js-collect-params-loop params (+ i 1)
|
|
(append result (js-mangle (symbol-name (first p)))) rest-name)
|
|
;; Something else
|
|
:else
|
|
(js-collect-params-loop params (+ i 1)
|
|
(append result (str p)) rest-name))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; let → IIFE (immediately invoked function expression)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-let
|
|
(fn (expr)
|
|
;; Detect named let: (let name ((x init) ...) body...)
|
|
(if (= (type-of (nth expr 1)) "symbol")
|
|
(js-emit-named-let expr)
|
|
(let ((bindings (nth expr 1))
|
|
(body (rest (rest expr))))
|
|
(let ((binding-lines (js-parse-let-bindings bindings))
|
|
(body-strs (list)))
|
|
(begin
|
|
(for-each (fn (b) (append! body-strs (str " " (js-statement b))))
|
|
(slice body 0 (- (len body) 1)))
|
|
(append! body-strs (str " return " (js-expr (last body)) ";"))
|
|
(str "(function() {\n"
|
|
(join "\n" binding-lines)
|
|
(if (empty? binding-lines) "" "\n")
|
|
(join "\n" body-strs)
|
|
"\n})()")))))))
|
|
|
|
;; Named let: (let loop-name ((param init) ...) body...)
|
|
;; Emits a named IIFE: (function loop(p1, p2) { body })(init1, init2)
|
|
(define js-emit-named-let
|
|
(fn (expr)
|
|
(let ((loop-name (symbol-name (nth expr 1)))
|
|
(bindings (nth expr 2))
|
|
(body (slice expr 3))
|
|
(params (list))
|
|
(inits (list)))
|
|
;; Parse bindings — Scheme-style ((name val) ...)
|
|
(for-each
|
|
(fn (b)
|
|
(let ((pname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b)))))
|
|
(append! params (js-mangle pname))
|
|
(append! inits (js-expr (nth b 1)))))
|
|
bindings)
|
|
;; Emit body statements + return last
|
|
(let ((body-strs (list))
|
|
(mangled-name (js-mangle loop-name)))
|
|
(for-each (fn (b) (append! body-strs (str " " (js-statement b))))
|
|
(slice body 0 (- (len body) 1)))
|
|
(append! body-strs (str " return " (js-expr (last body)) ";"))
|
|
(str "(function " mangled-name "(" (join ", " params) ") {\n"
|
|
(join "\n" body-strs)
|
|
"\n})(" (join ", " inits) ")")))))
|
|
|
|
(define js-parse-let-bindings
|
|
(fn (bindings)
|
|
(if (not (and (list? bindings) (not (empty? bindings))))
|
|
(list)
|
|
(if (list? (first bindings))
|
|
;; Scheme-style: ((name val) ...)
|
|
(map (fn (b)
|
|
(let ((vname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b)))))
|
|
(str " var " (js-mangle vname) " = " (js-expr (nth b 1)) ";")))
|
|
bindings)
|
|
;; Clojure-style: (name val name val ...)
|
|
(js-parse-clojure-let-bindings bindings 0 (list))))))
|
|
|
|
(define js-parse-clojure-let-bindings
|
|
(fn (bindings (i :as number) (result :as list))
|
|
(if (>= i (- (len bindings) 1))
|
|
result
|
|
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i)))))
|
|
(js-parse-clojure-let-bindings bindings (+ i 2)
|
|
(append result (str " var " (js-mangle vname) " = "
|
|
(js-expr (nth bindings (+ i 1))) ";")))))))
|
|
|
|
(define js-emit-let-bindings-as-vars
|
|
(fn (bindings)
|
|
(if (not (and (list? bindings) (not (empty? bindings))))
|
|
""
|
|
(if (list? (first bindings))
|
|
;; Scheme-style
|
|
(str (join " " (map (fn (b)
|
|
(let ((vname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b)))))
|
|
(str "var " (js-mangle vname) " = " (js-expr (nth b 1)) ";")))
|
|
bindings)) " ")
|
|
;; Clojure-style
|
|
(str (js-emit-clojure-let-vars bindings 0 (list)) " ")))))
|
|
|
|
(define js-emit-clojure-let-vars
|
|
(fn (bindings (i :as number) (result :as list))
|
|
(if (>= i (- (len bindings) 1))
|
|
(join " " result)
|
|
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i)))))
|
|
(js-emit-clojure-let-vars bindings (+ i 2)
|
|
(append result (str "var " (js-mangle vname) " = "
|
|
(js-expr (nth bindings (+ i 1))) ";")))))))
|
|
|
|
;; Helper to append let binding var declarations to a parts list
|
|
(define js-append-let-binding-parts
|
|
(fn (bindings (parts :as list))
|
|
(when (and (list? bindings) (not (empty? bindings)))
|
|
(if (list? (first bindings))
|
|
;; Scheme-style
|
|
(for-each (fn (b)
|
|
(let ((vname (if (= (type-of (first b)) "symbol")
|
|
(symbol-name (first b))
|
|
(str (first b)))))
|
|
(append! parts (str "var " (js-mangle vname) " = " (js-expr (nth b 1)) ";"))))
|
|
bindings)
|
|
;; Clojure-style
|
|
(js-append-clojure-bindings bindings parts 0)))))
|
|
|
|
(define js-append-clojure-bindings
|
|
(fn (bindings (parts :as list) (i :as number))
|
|
(when (< i (- (len bindings) 1))
|
|
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
|
(symbol-name (nth bindings i))
|
|
(str (nth bindings i)))))
|
|
(begin
|
|
(append! parts (str "var " (js-mangle vname) " = "
|
|
(js-expr (nth bindings (+ i 1))) ";"))
|
|
(js-append-clojure-bindings bindings parts (+ i 2)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; when → ternary
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-when
|
|
(fn (expr)
|
|
(let ((cond-e (js-expr (nth expr 1)))
|
|
(body-parts (rest (rest expr))))
|
|
(if (= (len body-parts) 1)
|
|
(str "(isSxTruthy(" cond-e ") ? " (js-expr (first body-parts)) " : NIL)")
|
|
(str "(isSxTruthy(" cond-e ") ? " (js-emit-do body-parts) " : NIL)")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; cond → chained ternaries
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-cond
|
|
(fn ((clauses :as list))
|
|
(if (empty? clauses)
|
|
"NIL"
|
|
;; Detect scheme vs clojure style
|
|
(let ((is-scheme (and
|
|
(every? (fn (c) (and (list? c) (= (len c) 2))) clauses)
|
|
(not (some (fn (c) (= (type-of c) "keyword")) clauses)))))
|
|
(if is-scheme
|
|
(js-cond-scheme clauses)
|
|
(js-cond-clojure clauses))))))
|
|
|
|
(define js-is-else?
|
|
(fn (test)
|
|
(or (and (= (type-of test) "symbol")
|
|
(or (= (symbol-name test) "else") (= (symbol-name test) ":else")))
|
|
(and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
|
|
|
|
(define js-cond-scheme
|
|
(fn ((clauses :as list))
|
|
(if (empty? clauses)
|
|
"NIL"
|
|
(let ((clause (first clauses))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(if (js-is-else? test)
|
|
(js-expr body)
|
|
(str "(isSxTruthy(" (js-expr test) ") ? " (js-expr body)
|
|
" : " (js-cond-scheme (rest clauses)) ")"))))))
|
|
|
|
(define js-cond-clojure
|
|
(fn ((clauses :as list))
|
|
(if (< (len clauses) 2)
|
|
"NIL"
|
|
(let ((test (first clauses))
|
|
(body (nth clauses 1)))
|
|
(if (js-is-else? test)
|
|
(js-expr body)
|
|
(str "(isSxTruthy(" (js-expr test) ") ? " (js-expr body)
|
|
" : " (js-cond-clojure (rest (rest clauses))) ")"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; case → IIFE with if/else chain
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-case
|
|
(fn ((args :as list))
|
|
(let ((match-expr (js-expr (first args)))
|
|
(clauses (rest args)))
|
|
(str "(function() { var _m = " match-expr "; "
|
|
(js-case-chain clauses) " })()"))))
|
|
|
|
(define js-case-chain
|
|
(fn ((clauses :as list))
|
|
(if (< (len clauses) 2)
|
|
"return NIL;"
|
|
(let ((test (nth clauses 0))
|
|
(body (nth clauses 1)))
|
|
(if (js-is-else? test)
|
|
(str "return " (js-expr body) ";")
|
|
(str "if (_m == " (js-expr test) ") return "
|
|
(js-expr body) "; "
|
|
(js-case-chain (rest (rest clauses)))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; and → && with isSxTruthy
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-and
|
|
(fn ((args :as list))
|
|
(let ((parts (map js-expr args)))
|
|
(if (= (len parts) 1)
|
|
(first parts)
|
|
;; All but last wrapped in isSxTruthy, last returned as-is
|
|
(str "(" (join " && " (map (fn (p) (str "isSxTruthy(" p ")"))
|
|
(slice parts 0 (- (len parts) 1))))
|
|
" && " (last parts) ")")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; or → sxOr()
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-or
|
|
(fn ((args :as list))
|
|
(if (= (len args) 1)
|
|
(js-expr (first args))
|
|
(str "sxOr(" (join ", " (map js-expr args)) ")"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; do/begin → comma operator
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-do
|
|
(fn ((args :as list))
|
|
(if (= (len args) 1)
|
|
(js-expr (first args))
|
|
(str "(" (join ", " (map js-expr args)) ")"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; dict literal → JS object
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-dict-literal
|
|
(fn ((pairs :as list))
|
|
(str "{" (js-dict-pairs-str pairs 0 (list)) "}")))
|
|
|
|
(define js-dict-pairs-str
|
|
(fn ((pairs :as list) (i :as number) (result :as list))
|
|
(if (>= i (- (len pairs) 1))
|
|
(join ", " result)
|
|
(let ((key (nth pairs i))
|
|
(val (nth pairs (+ i 1))))
|
|
(let ((key-str (if (= (type-of key) "keyword")
|
|
(js-quote-string (keyword-name key))
|
|
(str "[" (js-expr key) "]")))
|
|
(val-str (js-expr val)))
|
|
(js-dict-pairs-str pairs (+ i 2)
|
|
(append result (str key-str ": " val-str))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Infix operators
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-infix
|
|
(fn ((op :as string) (args :as list))
|
|
(let ((js-op (js-op-symbol op))
|
|
(n (len args)))
|
|
(cond
|
|
(and (= n 1) (= op "-"))
|
|
(str "(-" (js-expr (first args)) ")")
|
|
(= n 2)
|
|
(str "(" (js-expr (first args))
|
|
" " js-op " " (js-expr (nth args 1)) ")")
|
|
;; Variadic: left-fold (a op b op c op d ...)
|
|
:else
|
|
(let ((result (js-expr (first args))))
|
|
(for-each (fn (arg)
|
|
(set! result (str "(" result " " js-op " " (js-expr arg) ")")))
|
|
(rest args))
|
|
result)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; quote → JS AST literals
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-quote
|
|
(fn (expr)
|
|
(cond
|
|
(= (type-of expr) "boolean")
|
|
(if expr "true" "false")
|
|
(number? expr) (str expr)
|
|
(string? expr) (js-quote-string expr)
|
|
(nil? expr) "NIL"
|
|
(= (type-of expr) "symbol")
|
|
(str "new Symbol(" (js-quote-string (symbol-name expr)) ")")
|
|
(= (type-of expr) "keyword")
|
|
(str "new Keyword(" (js-quote-string (keyword-name expr)) ")")
|
|
(list? expr)
|
|
(str "[" (join ", " (map js-emit-quote expr)) "]")
|
|
:else (str expr))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Statement translator: SX AST → JS statement string
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-statement
|
|
(fn (expr)
|
|
(if (and (list? expr) (not (empty? expr))
|
|
(= (type-of (first expr)) "symbol"))
|
|
(let ((name (symbol-name (first expr))))
|
|
(cond
|
|
(= name "define")
|
|
(js-emit-define expr)
|
|
(= name "set!")
|
|
(str (js-mangle (symbol-name (nth expr 1))) " = "
|
|
(js-expr (nth expr 2)) ";")
|
|
(= name "when")
|
|
(js-emit-when-stmt expr)
|
|
(or (= name "do") (= name "begin"))
|
|
(join "\n" (map js-statement (rest expr)))
|
|
(= name "for-each")
|
|
(js-emit-for-each-stmt expr)
|
|
(= name "dict-set!")
|
|
(str (js-expr (nth expr 1)) "[" (js-expr (nth expr 2))
|
|
"] = " (js-expr (nth expr 3)) ";")
|
|
(= name "append!")
|
|
(str (js-expr (nth expr 1)) ".push(" (js-expr (nth expr 2)) ");")
|
|
(= name "env-bind!")
|
|
(str "envBind(" (js-expr (nth expr 1))
|
|
", " (js-expr (nth expr 2))
|
|
", " (js-expr (nth expr 3)) ");")
|
|
(= name "env-set!")
|
|
(str "envSet(" (js-expr (nth expr 1))
|
|
", " (js-expr (nth expr 2))
|
|
", " (js-expr (nth expr 3)) ");")
|
|
(= name "set-lambda-name!")
|
|
(str (js-expr (nth expr 1)) ".name = " (js-expr (nth expr 2)) ";")
|
|
:else
|
|
(str (js-expr expr) ";")))
|
|
(str (js-expr expr) ";"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; define → var declaration with self-tail-recursion optimization
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-define
|
|
(fn (expr)
|
|
;; Handle (define name :effects [...] value) — skip :effects annotation
|
|
(let ((name (if (= (type-of (nth expr 1)) "symbol")
|
|
(symbol-name (nth expr 1))
|
|
(str (nth expr 1))))
|
|
(val-expr (if (and (>= (len expr) 5)
|
|
(= (type-of (nth expr 2)) "keyword")
|
|
(= (keyword-name (nth expr 2)) "effects"))
|
|
(nth expr 4)
|
|
(nth expr 2))))
|
|
(let ((mangled (js-mangle name))
|
|
(var-decl
|
|
(if (nil? val-expr)
|
|
(str "var " (js-mangle name) " = NIL;")
|
|
;; Detect zero-arg self-tail-recursive functions → while loops
|
|
(if (and (list? val-expr)
|
|
(not (empty? val-expr))
|
|
(= (type-of (first val-expr)) "symbol")
|
|
(or (= (symbol-name (first val-expr)) "fn")
|
|
(= (symbol-name (first val-expr)) "lambda"))
|
|
(list? (nth val-expr 1))
|
|
(= (len (nth val-expr 1)) 0)
|
|
(js-is-self-tail-recursive? name (rest (rest val-expr))))
|
|
;; While loop optimization
|
|
(let ((body (rest (rest val-expr)))
|
|
(loop-body (js-emit-loop-body name body)))
|
|
(str "var " mangled " = function() { while(true) { " loop-body " } };"))
|
|
;; Normal define
|
|
(str "var " mangled " = " (js-expr val-expr) ";")))))
|
|
;; Self-register: every spec define is available to evaluated SX code
|
|
(str var-decl "\nPRIMITIVES[\"" name "\"] = " mangled ";")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; when as statement → if block
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-when-stmt
|
|
(fn (expr)
|
|
(let ((cond-e (js-expr (nth expr 1)))
|
|
(body-parts (rest (rest expr))))
|
|
(str "if (isSxTruthy(" cond-e ")) {\n"
|
|
(join "\n" (map (fn (e) (str " " (js-statement e))) body-parts))
|
|
"\n}"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; for-each as statement → for loop
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-emit-for-each-stmt
|
|
(fn (expr)
|
|
(let ((fn-expr (nth expr 1))
|
|
(coll-expr (nth expr 2))
|
|
(coll (js-expr coll-expr)))
|
|
(if (and (list? fn-expr)
|
|
(= (type-of (first fn-expr)) "symbol")
|
|
(= (symbol-name (first fn-expr)) "fn"))
|
|
;; Inline lambda → for loop
|
|
(let ((params (nth fn-expr 1))
|
|
(body (rest (rest fn-expr)))
|
|
(raw-p (first params))
|
|
(p (cond
|
|
(= (type-of raw-p) "symbol")
|
|
(symbol-name raw-p)
|
|
;; (name :as type) annotation → extract name
|
|
(and (= (type-of raw-p) "list") (= (len raw-p) 3)
|
|
(= (type-of (nth raw-p 1)) "keyword")
|
|
(= (keyword-name (nth raw-p 1)) "as"))
|
|
(symbol-name (first raw-p))
|
|
:else (str raw-p)))
|
|
(p-js (js-mangle p)))
|
|
(str "{ var _c = " coll "; for (var _i = 0; _i < _c.length; _i++) { var "
|
|
p-js " = _c[_i]; "
|
|
(join "\n" (map js-statement body)) " } }"))
|
|
;; Non-inline → for loop with function call
|
|
(str "{ var _c = " coll "; for (var _i = 0; _i < _c.length; _i++) { "
|
|
(js-expr fn-expr) "(_c[_i]); } }")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; File translation: process a list of (name, define-expr) pairs
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define js-translate-file
|
|
(fn ((defines :as list))
|
|
(join "\n" (map (fn (pair)
|
|
(let ((name (first pair))
|
|
(expr (nth pair 1)))
|
|
(str " // " name "\n " (js-statement expr) "\n")))
|
|
defines))))
|