(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")) (define js-renames {:ho-filter "hoFilter" :thunk-env "thunkEnv" :cek-run "cekRun" :*custom-special-forms* "_customSpecialForms" :with-island-scope "withIslandScope" :step-sf-if "stepSfIf" :dom-is-fragment? "domIsFragment" :process-bindings "processBindings" :call-thunk "callThunk" :fetch-streaming "fetchStreaming" :bind-inline-handlers "bindInlineHandlers" :set-interval "setInterval_" :number? "isNumber" :reactive-list "reactiveList" :expand-macro "expandMacro" :handle-history "handleHistory" :page-render-plan "pageRenderPlan" :make-let-frame "makeLetFrame" :parse-comp-params "parseCompParams" :next-retry-ms "nextRetryMs" :fetch-request "fetchRequest" :kont-push "kontPush" :macro-body "macroBody" :for-each-indexed "forEachIndexed" :step-ho-for-each "stepHoForEach" :set-render-active! "setRenderActiveB" :local-storage-set "localStorageSet" :dom-get-attr "domGetAttr" :parse-element-args "parseElementArgs" :process-emit-elements "processEmitElements" :build-request-body "buildRequestBody" :kont-top "kontTop" :event-detail "eventDetail" :match-route "matchRoute" :handle-popstate "handlePopstate" :event-source-listen "eventSourceListen" :select-from-container "selectFromContainer" :try-eval-content "tryEvalContent" :query-page-scripts "queryPageScripts" :scope-emit! "scopeEmit" :promise-delayed "promiseDelayed" :make-call-frame "makeCallFrame" :HTML_TAGS "HTML_TAGS" :macro-rest-param "macroRestParam" :env-has? "envHas" :make-raw-html "makeRawHtml" :dom-set-style "domSetStyle" :try-parse-json "tryParseJson" :host-call "hostCall" :VERB_SELECTOR "VERB_SELECTOR" :render-dom-element "renderDomElement" :escape-html "escapeHtml" :parse-sse-swap "parseSseSwap" :disable-elements "disableElements" :starts-with? "startsWith" :parse-env-attr "parseEnvAttr" :ho-some "hoSome" :eval-cond-scheme "evalCondScheme" :ends-with? "endsWith" :>= "gte_" :dom-dispatch "domDispatch" :preload-cache-set "preloadCacheSet" :signal-subscribers "signalSubscribers" :step-sf-provide "stepSfProvide" :signal-add-sub! "signalAddSub" :render-lambda-html "renderLambdaHtml" :dom-set-data "domSetData" :make-thread-frame "makeThreadFrame" :make-sx-expr "makeSxExpr" :pop-wind! "popWind" :dom-append-to-head "domAppendToHead" :hoist-head-elements "hoistHeadElements" :make-reset-frame "makeResetFrame" :flush-subscribers "flushSubscribers" :controller-signal "controllerSignal" :clear-interval "clearInterval_" :children-to-fragment "childrenToFragment" :sx-render-component "sxRenderComponent" :with-transition "withTransition" :scan-io-refs-walk "scanIoRefsWalk" :step-sf-scope "stepSfScope" :get-primitive "getPrimitive" :_preload-cache "_preloadCache" :select-html-from-doc "selectHtmlFromDoc" :browser-location-href "browserLocationHref" :sf-case-loop "sfCaseLoop" :sf-dynamic-wind "sfDynamicWind" :symbol-name "symbolName" :set-lambda-name! "setLambdaName" :host-get "hostGet" :aser-fragment "aserFragment" :render-dom-unknown-component "renderDomUnknownComponent" :!= "notEqual_" :SX_VERSION "SX_VERSION" :render-html-element "renderHtmlElement" :dom-first-child "domFirstChild" :bind-client-route-click "bindClientRouteClick" :sf-cond-clojure "sfCondClojure" :MATH_NS "MATH_NS" :default-trigger "defaultTrigger" :signal-remove-sub! "signalRemoveSub" :make-cek-state "makeCekState" :emit! "sxEmit" :sf-quote "sfQuote" :bind-boost-form "bindBoostForm" :component-params "componentParams" :do-preload "doPreload" :component-affinity "componentAffinity" :eval-case-aser "evalCaseAser" :sf-begin "sfBegin" :revert-optimistic "revertOptimistic" :whitespace? "isWhitespace" :host-typeof "hostTypeof" :dom-insert-adjacent-html "domInsertAdjacentHtml" :step-sf-set! "stepSfSet" :error-message "errorMessage" :schedule-idle "scheduleIdle" :find-matching-route "findMatchingRoute" :component-body "componentBody" :qq-expand "qqExpand" :provide-push! "providePush" :make-keyword "makeKeyword" :do-fetch "doFetch" :component-deps "componentDeps" :component-set-io-refs! "componentSetIoRefs" :escape-string "escapeString" :make-island "makeIsland" :nil "NIL" :log-parse-error "logParseError" :enable-cek-reactive! "enableCekReactive" :signal-set-value! "signalSetValue" :env-set! "envSet" :clear-timeout "clearTimeout_" :sf-defcomp "sfDefcomp" :step-ho-map "stepHoMap" :dom-parse-html "domParseHtml" :make-lambda "makeLambda" :sf-if "sfIf" :make-route-segment "makeRouteSegment" :lambda-closure "lambdaClosure" :render-target "renderTarget" :dom-attr-list "domAttrList" :log-warn "logWarn" :eval-call "evalCall" :sync-attrs "syncAttrs" :make-case-frame "makeCaseFrame" :render-dom-component "renderDomComponent" :dom-child-nodes "domChildNodes" :collect! "sxCollect" :use-store "useStore" :classify-trigger "classifyTrigger" :engine-init "engineInit" :list? "isList" :index-of "indexOf_" :component-io-refs "componentIoRefs" :dom-remove "domRemove" :set-document-title "setDocumentTitle" :primitive? "isPrimitive" :parse-trigger-spec "parseTriggerSpec" :local-storage-get "localStorageGet" :dom-get-data "domGetData" :scan-refs-walk "scanRefsWalk" :abort-previous-target "abortPreviousTarget" :thunk-expr "thunkExpr" :create-comment "createComment" :component-closure "componentClosure" :render-dom-form? "isRenderDomForm" :sx-render-with-env "sxRenderWithEnv" :cek-phase "cekPhase" :prevent-default "preventDefault_" :true "true" :definition-form? "isDefinitionForm" :make-map-frame "makeMapFrame" :scope-pop! "scopePop" :contains? "contains" :bind-preload-for "bindPreloadFor" :dom-focus "domFocus" :sf-thread-first "sfThreadFirst" :find-oob-swaps "findOobSwaps" :dom-query-by-id "domQueryById" :handle-sx-response "handleSxResponse" :page-css-classes "pageCssClasses" :odd? "isOdd" :compute-all-deps "computeAllDeps" :has-reactive-reset-frame? "hasReactiveResetFrame_p" :sx-expr-source "sxExprSource" :render-html-form? "isRenderHtmlForm" :lambda-name "lambdaName" :parse-number "parseNumber" :regex-find-all "regexFindAll" :step-sf-define "stepSfDefine" :resolve-mount-target "resolveMountTarget" :emitted "sxEmitted" :browser-push-state "browserPushState" :signal-value "signalValue" :sf-defmacro "sfDefmacro" :swap-dom-nodes "swapDomNodes" :scan-components-from-source "scanComponentsFromSource" :lambda-body "lambdaBody" :scope-peek "scopePeek" :signal-deps "signalDeps" :aser-call "aserCall" :bind-sse-swap "bindSseSwap" :make-for-each-frame "makeForEachFrame" :make-and-frame "makeAndFrame" :parse-macro-params "parseMacroParams" :dispatch-trigger-events "dispatchTriggerEvents" :event-source-connect "eventSourceConnect" :type-of "typeOf" :map-indexed "mapIndexed" :render-lambda-dom "renderLambdaDom" :boot-init "bootInit" :clear-collected! "sxClearCollected" :render-value-to-html "renderValueToHtml" :dispatch-html-form "dispatchHtmlForm" :should-boost-link? "shouldBoostLink" :step-eval "stepEval" :morph-node "morphNode" :track-controller "trackController" :cek-kont "cekKont" :dom-query-all "domQueryAll" :env-merge "envMerge" :raw-html-content "rawHtmlContent" :reactive-fragment "reactiveFragment" :ho-map "hoMap" :browser-scroll-to "browserScrollTo" :render-attrs "renderAttrs" :RENDER_HTML_FORMS "RENDER_HTML_FORMS" :make-reduce-frame "makeReduceFrame" :*batch-depth* "_batchDepth" :kf-name "kfName" :parse-retry-spec "parseRetrySpec" :dom-document "domDocument" :render-to-sx "renderToSx" :host-global "hostGlobal" :scan-refs "scanRefs" :dom-replace-child "domReplaceChild" :signal-set-deps! "signalSetDeps" :empty-dict? "isEmptyDict" :execute-request "executeRequest" :step-eval-list "stepEvalList" :zero? "isZero" :dom-remove-child "domRemoveChild" :compute-all-io-refs "computeAllIoRefs" :sx-render "sxRender" :components-needed "componentsNeeded" :host-set! "hostSet" :sf-case "sfCase" :make-cek-continuation "makeCekContinuation" :sf-let "sfLet" :cek-env "cekEnv" :step-sf-lambda "stepSfLambda" :notify-subscribers "notifySubscribers" :*render-check* "_renderCheck" :step-sf-deref "stepSfDeref" :browser-media-matches? "browserMediaMatches" :parse-time "parseTime" :process-elements "processElements" :try-catch "tryCatch" :filter-params "filterParams" :ident-start? "isIdentStart" :format-date "formatDate" :def-store "defStore" :post-swap "postSwap" :fetch-preload "fetchPreload" :is-processed? "isProcessed" :call-lambda "callLambda" :_page-routes "_pageRoutes" :continuation-data "continuationData" :try-client-route "tryClientRoute" :merge-spread-attrs "mergeSpreadAttrs" :*use-cek-reactive* "_useCekReactive" :cek-step "cekStep" :promise-resolve "promiseResolve" :clear-processed! "clearProcessed" :step-sf-and "stepSfAnd" :strip-component-scripts "stripComponentScripts" :split-path-segments "splitPathSegments" :<= "lte_" :dom-has-class? "domHasClass" :bind-event "bindEvent" :render-to-html "renderToHtml" :dom-add-class "domAddClass" :process-one "processOne" :sx-hydrate "sxHydrate" :render-active? "renderActiveP" :collected "sxCollected" :clear-stores "clearStores" :dom-get-prop "domGetProp" :empty? "isEmpty" :step-sf-when "stepSfWhen" :strip-tags "stripTags" :component-has-children? "componentHasChildren" :VOID_ELEMENTS "VOID_ELEMENTS" :promise-then "promiseThen" :parse-swap-spec "parseSwapSpec" :json-parse "jsonParse" :dom-parent "domParent" :process-oob-swaps "processOobSwaps" :signal? "isSignal" :local-storage-remove "localStorageRemove" :register-io-deps "registerIoDeps" :parse-route-pattern "parseRoutePattern" :process-sx-scripts "processSxScripts" :*store-registry* "_storeRegistry" :dom-ensure-element "domEnsureElement" :eval-expr "evalExpr" :transitive-deps "transitiveDeps" :make-set-frame "makeSetFrame" :get-render-env "getRenderEnv" :sf-named-let "sfNamedLet" :reactive-shift-deref "reactiveShiftDeref" :escape-attr "escapeAttr" :process-component-script "processComponentScript" :transitive-io-refs "transitiveIoRefs" :component-pure? "componentPure_p" :sf-and "sfAnd" :apply-optimistic "applyOptimistic" :ho-every "hoEvery" :dom-parse-html-document "domParseHtmlDocument" :island? "isIsland" :emit-event "emitEvent" :step-ho-reduce "stepHoReduce" :render-dom-raw "renderDomRaw" :clear-loading-state "clearLoadingState" :dom-clone "domClone" :fetch-and-restore "fetchAndRestore" :render-dom-island "renderDomIsland" :step-sf-begin "stepSfBegin" :to-kebab "toKebab" :replace "replace_" :mark-processed! "markProcessed" :insert-remaining-siblings "insertRemainingSiblings" :sx-update-element "sxUpdateElement" :env-extend "envExtend" :handle-html-response "handleHtmlResponse" :dict-delete! "dictDelete" :make-component "makeComponent" :make-cond-frame "makeCondFrame" :sx-load-components "sxLoadComponents" :sf-lambda "sfLambda" :abort-previous "abortPrevious" :step-eval-call "stepEvalCall" :store-env-attr "storeEnvAttr" :chunk-every "chunkEvery" :dom-append "domAppend" :eval-cond-clojure "evalCondClojure" :morph-children "morphChildren" :make-when-frame "makeWhenFrame" :frame-type "frameType" :dom-set-inner-html "domSetInnerHtml" :process-response-headers "processResponseHeaders" :dom-query "domQuery" :dom-remove-class "domRemoveClass" :thunk? "isThunk" :kont-pop "kontPop" :eval-list "evalList" :resolve-target "resolveTarget" :dom-is-child-of? "domIsChildOf" :lambda? "isLambda" :dom-insert-after "domInsertAfter" :make-dynamic-wind-frame "makeDynamicWindFrame" :promise-catch "promiseCatch" :host-new "hostNew" :kont-capture-to-reactive-reset "kontCaptureToReactiveReset" :serialize-island-state "serializeIslandState" :handle-retry "handleRetry" :step-sf-thread-first "stepSfThreadFirst" :make-reactive-reset-frame "makeReactiveResetFrame" :dom-listen "domListen" :even? "isEven" :get-verb-info "getVerbInfo" :dispose-island "disposeIsland" :dom-child-list "domChildList" :log-info "logInfo" :macro-closure "macroClosure" :dict-has? "dictHas" :browser-reload "browserReload" :cond-scheme? "condScheme_p" :make-scope-frame "makeScopeFrame" :sf-define "sfDefine" :ident-char? "isIdentChar" :sx-serialize "sxSerialize" :render-dom-fragment "renderDomFragment" :dom-has-attr? "domHasAttr" :dom-is-active-element? "domIsActiveElement" :dom-create-element "domCreateElement" :create-text-node "createTextNode" :lambda-params "lambdaParams" :host-await "hostAwait" :macro? "isMacro" :dom-text-content "domTextContent" :step-sf-case "stepSfCase" :request-animation-frame "requestAnimationFrame_" :sf-case-step-loop "sfCaseStepLoop" :process-boosted "processBoosted" :sf-cond "sfCond" :dom-head "domHead" :component-io-refs-cached "componentIoRefsCached" :bind-triggers "bindTriggers" :every? "isEvery" :dom-closest "domClosest" :component? "isComponent" :make-handler-def "makeHandlerDef" :should-boost-form? "shouldBoostForm" :parse-header-value "parseHeaderValue" :render-to-dom "renderToDom" :make-or-frame "makeOrFrame" :has-key? "dictHas" :dom-body-inner-html "domBodyInnerHtml" :process-css-response "processCssResponse" :url-pathname "urlPathname" :aser-special "aserSpecial" :create-script-clone "createScriptClone" :match-route-segments "matchRouteSegments" :cek-reactive-text "cekReactiveText" :PRELOAD_TTL "PRELOAD_TTL" :cek-control "cekControl" :bridge-event "bridgeEvent" :resolve-suspense "resolveSuspense" :dom-remove-children-after "domRemoveChildrenAfter" :track-controller-target "trackControllerTarget" :clear-sx-comp-cookie "clearSxCompCookie" :cross-origin? "isCrossOrigin" :extract-response-css "extractResponseCss" :bind-sse "bindSse" :show-indicator "showIndicator" :bind-client-route-link "bindClientRouteLink" :scope-push! "scopePush" :component-set-deps! "componentSetDeps" :element-value "elementValue" :cek-try "cekTry" :make-page-def "makePageDef" :render-html-component "renderHtmlComponent" :ENGINE_VERBS "ENGINE_VERBS" :process-sse "processSse" :loaded-component-names "loadedComponentNames" :browser-replace-state "browserReplaceState" :dom-next-sibling "domNextSibling" :sf-when "sfWhen" :sx-mount "sxMount" :make-query-def "makeQueryDef" :activate-scripts "activateScripts" :now-ms "nowMs" :bind-preload "bindPreload" :preload-cache-get "preloadCacheGet" :validate-for-request "validateForRequest" :BOOLEAN_ATTRS "BOOLEAN_ATTRS" :digit? "isDigit" :zip-pairs "zipPairs" :dom-set-text-content "domSetTextContent" :parse-keyword-args "parseKeywordArgs" :ho-map-indexed "hoMapIndexed" :cek-value "cekValue" :env-components "envComponents" :dict? "isDict" :is-else-clause? "isElseClause" :reactive-attr "reactiveAttr" :sf-quasiquote "sfQuasiquote" :create-fragment "createFragment" :is-render-expr? "isRenderExpr" :spread-attrs "spreadAttrs" :render-html-island "renderHtmlIsland" :aser-list "aserList" :provide-pop! "providePop" :swap-html-string "swapHtmlString" :render-expr "renderExpr" :dom-set-attr "domSetAttr" :boost-descendants "boostDescendants" :browser-prompt "browserPrompt" :HEAD_HOIST_SELECTOR "HEAD_HOIST_SELECTOR" :make-deref-frame "makeDerefFrame" :dom-tag-name "domTagName" :scope-emitted "sxEmitted" :query-sx-scripts "querySxScripts" :strip-prefix "stripPrefix" :scan-io-refs "scanIoRefs" :step-sf-cond "stepSfCond" :dom-id "domId" :dom-body "domBody" :make-macro "makeMacro" :identical? "isIdentical" :cek-reactive-attr "cekReactiveAttr" :step-sf-or "stepSfOr" :render-dom-list "renderDomList" :init-css-tracking "initCssTracking" :sx-serialize-dict "sxSerializeDict" :try-async-eval-content "tryAsyncEvalContent" :register-in-scope "registerInScope" :cek-terminal? "cekTerminal_p" :step-ho-filter "stepHoFilter" :sf-set! "sfSetBang" :false "false" :browser-navigate "browserNavigate" :dom-node-type "domNodeType" :bind-boost-link "bindBoostLink" :scan-css-classes "scanCssClasses" :dom-matches? "domMatches" :set-sx-comp-cookie "setSxCompCookie" :ho-reduce "hoReduce" :ho-form? "isHoForm" :macro-params "macroParams" :on-event "onEvent" :parse-int "parseInt_" :step-sf-reset "stepSfReset" :*render-fn* "_renderFn" :dom-outer-html "domOuterHtml" :special-form? "isSpecialForm" :observe-intersection "observeIntersection" :make-env "makeEnv" :make-signal "makeSignal" :push-wind! "pushWind" :dom-set-prop "domSetProp" :eval-expr-cek "evalExprCek" :callable? "isCallable" :sf-defisland "sfDefisland" :kont-capture-to-reset "kontCaptureToReset" :handle-fetch-success "handleFetchSuccess" :dom-get-style "domGetStyle" :sf-cond-scheme "sfCondScheme" :keyword-name "keywordName" :env-bind! "envBind" :map-dict "mapDict" :host-callback "hostCallback" :remove-head-element "removeHeadElement" :context "sxContext" :dom-is-input-element? "domIsInputElement" :spread? "isSpread" :make-cek-value "makeCekValue" :step-continue "stepContinue" :dom-window "domWindow" :hydrate-island "hydrateIsland" :make-action-def "makeActionDef" :kont-empty? "kontEmpty_p" :make-filter-frame "makeFilterFrame" :make-thunk "makeThunk" :make-symbol "makeSymbol" :dict-get "dictGet" :dispatch-render-form "dispatchRenderForm" :dom-prepend "domPrepend" :make-begin-frame "makeBeginFrame" :merge-envs "mergeEnvs" :continue-with-call "continueWithCall" :browser-confirm "browserConfirm" :make-spread "makeSpread" :register-special-form! "registerSpecialForm" :csrf-token "csrfToken" :for-each "forEach" :make-dict-frame "makeDictFrame" :trampoline-cek "trampolineCek" :sf-letrec "sfLetrec" :DEFAULT_SWAP "DEFAULT_SWAP" :component-name "componentName" :*batch-queue* "_batchQueue" :component-css-classes "componentCssClasses" :make-arg-frame "makeArgFrame" :dict-set! "dictSet" :step-sf-let "stepSfLet" :browser-same-origin? "browserSameOrigin" :sx-hydrate-islands "sxHydrateIslands" :make-define-frame "makeDefineFrame" :process-page-scripts "processPageScripts" :ho-for-each "hoForEach" :stop-propagation "stopPropagation_" :sx-process-scripts "sxProcessScripts" :make-if-frame "makeIfFrame" :sf-or "sfOr" :dom-insert-before "domInsertBefore" :step-sf-shift "stepSfShift" :format-decimal "formatDecimal" :json-serialize "jsonSerialize" :defcomp-kwarg "defcompKwarg" :reactive-text "reactiveText" :dom-remove-attr "domRemoveAttr" :eval-cond "evalCond" :_css-hash "_cssHash" :fetch-location "fetchLocation" :sx-hydrate-elements "sxHydrateElements" :dispose-computed "disposeComputed" :abort-error? "isAbortError" :set-timeout "setTimeout_" :new-abort-controller "newAbortController" :nil? "isNil" :env-get "envGet" :call-component "callComponent" :SVG_NS "SVG_NS" :RENDER_DOM_FORMS "RENDER_DOM_FORMS" :build-request-headers "buildRequestHeaders" :page-component-bundle "pageComponentBundle" :render-list-to-html "renderListToHtml" :string? "isString" :dom-node-name "domNodeName" :hoist-head-elements-full "hoistHeadElementsFull"}) (define js-mangle (fn ((name :as string)) (let ((renamed (get js-renames name))) (if (not (nil? renamed)) renamed (let ((result (replace name "*" "_"))) (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))) (let ((result (js-kebab-to-camel result))) (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))))) (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") "\""))) (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))) (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 (= h name) true (= 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))))))) (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 (= h name) "continue;" (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))) (= 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;") " }") (= 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; }")) (= h "cond") (js-emit-cond-as-loop-stmt name (rest expr)) (or (= h "let") (= h "let*")) (let ((bindings (nth expr 1)) (body (rest (rest expr))) (parts (list))) (begin (js-append-let-binding-parts bindings parts) (for-each (fn (e) (append! parts (js-statement e))) (slice body 0 (- (len body) 1))) (append! parts (js-emit-tail-as-stmt name (last body))) (str "{ " (join "\n" parts) " }"))) :else (str "return " (js-expr expr) ";")))))))) (define js-emit-cond-as-loop-stmt (fn ((name :as string) (clauses :as list)) (if (empty? clauses) "return NIL;" (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) " }"))))))) (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)))))) (define js-expr (fn (expr) (cond (= (type-of expr) "boolean") (if expr "true" "false") (nil? expr) "NIL" (number? expr) (str expr) (string? expr) (js-quote-string expr) (= (type-of expr) "symbol") (js-mangle (symbol-name expr)) (= (type-of expr) "keyword") (js-quote-string (keyword-name expr)) (= (type-of expr) "dict") (js-emit-native-dict expr) (list? expr) (if (empty? expr) "[]" (js-emit-list expr)) :else (str expr)))) (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)) "}")))) (define js-emit-list (fn (expr) (let ((head (first expr)) (args (rest expr))) (if (not (= (type-of head) "symbol")) (if (= (type-of head) "list") (str "(" (js-expr head) ")(" (join ", " (map js-expr args)) ")") (str "[" (join ", " (map js-expr expr)) "]")) (let ((op (symbol-name head))) (cond (or (= op "fn") (= op "lambda")) (js-emit-fn expr) (or (= op "let") (= op "let*")) (js-emit-let expr) (= 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 ")")) (= op "when") (js-emit-when expr) (= op "cond") (js-emit-cond args) (= op "case") (js-emit-case args) (= op "and") (js-emit-and args) (= op "or") (js-emit-or args) (= op "not") (str "!isSxTruthy(" (js-expr (first args)) ")") (or (= op "do") (= op "begin")) (js-emit-do args) (= op "list") (str "[" (join ", " (map js-expr args)) "]") (= op "dict") (js-emit-dict-literal args) (= op "quote") (js-emit-quote (first args)) (= op "set!") (str "(" (js-mangle (symbol-name (first args))) " = " (js-expr (nth args 1)) ")") (= op "str") (if (empty? args) "\"\"" (str "(" (join " + " (map (fn (x) (str "String(" (js-expr x) ")")) args)) ")")) (= 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)) ")") (js-infix? op) (js-emit-infix op args) (= op "inc") (str "(" (js-expr (first args)) " + 1)") (= op "=") (str "sxEq(" (js-expr (first args)) ", " (js-expr (nth args 1)) ")") (= op "!=") (str "!sxEq(" (js-expr (first args)) ", " (js-expr (nth args 1)) ")") (= op "dec") (str "(" (js-expr (first args)) " - 1)") (= op "match") (js-emit-match args) :else (str (js-mangle op) "(" (join ", " (map js-expr args)) ")"))))))) (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) (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 "; }"))) (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 (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)) (= (type-of p) "symbol") (js-collect-params-loop params (+ i 1) (append result (js-mangle (symbol-name p))) rest-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) :else (js-collect-params-loop params (+ i 1) (append result (str p)) rest-name)))))) (define js-emit-let (fn (expr) (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})()"))))))) (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))) (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) (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)) (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) (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)) (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)) " ") (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))) ";"))))))) (define js-append-let-binding-parts (fn (bindings (parts :as list)) (when (and (list? bindings) (not (empty? bindings))) (if (list? (first bindings)) (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) (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))))))) (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)"))))) (define js-emit-cond (fn ((clauses :as list)) (if (empty? clauses) "NIL" (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))) ")")))))) (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-emit-match (fn ((args :as list)) (let ((match-expr (js-expr (first args))) (clauses (rest args))) (str "(function() { var _m = " match-expr "; " (js-match-chain clauses) " })()")))) (define js-match-chain (fn ((clauses :as list)) (if (empty? clauses) "return NIL;" (let ((clause (first clauses)) (pattern (first clause)) (body (nth clause 1))) (if (and (= (type-of pattern) "symbol") (= (symbol-name pattern) "_")) (str "return " (js-expr body) ";") (str "if (_m == " (js-expr pattern) ") return " (js-expr body) "; " (js-match-chain (rest 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))))))))) (define js-emit-and (fn ((args :as list)) (let ((parts (map js-expr args))) (if (= (len parts) 1) (first parts) (str "(" (join " && " (map (fn (p) (str "isSxTruthy(" p ")")) (slice parts 0 (- (len parts) 1)))) " && " (last parts) ")"))))) (define js-emit-or (fn ((args :as list)) (if (= (len args) 1) (js-expr (first args)) (str "sxOr(" (join ", " (map js-expr args)) ")")))) (define js-emit-do (fn ((args :as list)) (if (= (len args) 1) (js-expr (first args)) (str "(" (join ", " (map js-expr args)) ")")))) (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)))))))) (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)) ")") :else (let ((result (js-expr (first args)))) (for-each (fn (arg) (set! result (str "(" result " " js-op " " (js-expr arg) ")"))) (rest args)) result))))) (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)))) (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 js-emit-define (fn (expr) (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;") (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)))) (let ((body (rest (rest val-expr))) (loop-body (js-emit-loop-body name body))) (str "var " mangled " = function() { while(true) { " loop-body " } };")) (str "var " mangled " = " (js-expr val-expr) ";"))))) (str var-decl "\nPRIMITIVES[\"" name "\"] = " mangled ";"))))) (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}")))) (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")) (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) (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)) " } }")) (str "{ var _c = " coll "; for (var _i = 0; _i < _c.length; _i++) { " (js-expr fn-expr) "(_c[_i]); } }"))))) (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))))