giles
f828fb023b
Evaluator fixes (from broken match refactor in 8bba02f):
- Deref frame: use CEK state `value`, not `(get frame "value")`
- Deref frame: restore `(context "sx-reactive" nil)` (was undefined `get-tracking-context`)
- Scope-acc frame: restore missing `(get frame "value")` arg to make-scope-acc-frame
- Add missing `thread-insert-arg` helper for thread-first non-HO branch
Transpiler (hosts/javascript/transpiler.sx):
- Add `match` special form handler (IIFE with chained if/return, `_` wildcard)
- Replace `=`/`!=` infix `==` with `sxEq()` function call for proper symbol equality
JS platform (hosts/javascript/platform.py):
- Add `sxEq` for structural symbol/keyword comparison
- Add `componentFile`, `sort`, `defStore`/`useStore`/`clearStores` primitives
- Add `length`/`map`/`for-each`/`reduce` as VM-compatible HOF primitives
- Fix `SYM` → `makeSymbol` references
New files:
- sx/sx/stepper-lib.sx: extracted split-tag, build-code-tokens, steps-to-preview
JS tests: 0 → 1582/1585 passing (3 remaining are VM closure interop)
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1246 lines
50 KiB
Plaintext
1246 lines
50 KiB
Plaintext
(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))))
|