diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index 857a0f48..9cdee64f 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -1080,6 +1080,41 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { PRIMITIVES["slice"] = function(c, a, b) { if (!c || typeof c.slice !== "function") { console.error("[sx-debug] slice called on non-sliceable:", typeof c, c, "a=", a, "b=", b, new Error().stack); return []; } return b !== undefined ? c.slice(a, b) : c.slice(a); }; PRIMITIVES["substring"] = function(s, a, b) { return String(s).substring(a, b); }; PRIMITIVES["char-from-code"] = function(n) { return String.fromCharCode(n); }; + PRIMITIVES["char-code"] = function(s) { return String(s).charCodeAt(0); }; + var charCode = PRIMITIVES["char-code"]; + function makeChar(n) { return {_char: true, codepoint: n}; } + PRIMITIVES["make-char"] = makeChar; + var isChar = function(v) { return v != null && typeof v === "object" && v._char === true; }; + PRIMITIVES["char?"] = isChar; + var charToInteger = function(c) { return c.codepoint; }; + PRIMITIVES["char->integer"] = charToInteger; + var charUpcase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toUpperCase().charCodeAt(0)); }; + PRIMITIVES["char-upcase"] = charUpcase; + var charDowncase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toLowerCase().charCodeAt(0)); }; + PRIMITIVES["char-downcase"] = charDowncase; + PRIMITIVES["char=?"] = function(a, b) { return a.codepoint === b.codepoint; }; + PRIMITIVES["char?"] = function(a, b) { return a.codepoint > b.codepoint; }; + PRIMITIVES["char<=?"] = function(a, b) { return a.codepoint <= b.codepoint; }; + PRIMITIVES["char>=?"] = function(a, b) { return a.codepoint >= b.codepoint; }; + PRIMITIVES["char-ci=?"] = function(a, b) { return charDowncase(a).codepoint === charDowncase(b).codepoint; }; + PRIMITIVES["char-ci?"] = function(a, b) { return charDowncase(a).codepoint > charDowncase(b).codepoint; }; + PRIMITIVES["char-ci<=?"] = function(a, b) { return charDowncase(a).codepoint <= charDowncase(b).codepoint; }; + PRIMITIVES["char-ci>=?"] = function(a, b) { return charDowncase(a).codepoint >= charDowncase(b).codepoint; }; + PRIMITIVES["char-alphabetic?"] = function(c) { var n = c.codepoint; return (n >= 65 && n <= 90) || (n >= 97 && n <= 122); }; + PRIMITIVES["char-numeric?"] = function(c) { var n = c.codepoint; return n >= 48 && n <= 57; }; + PRIMITIVES["char-whitespace?"] = function(c) { var n = c.codepoint; return n === 32 || n === 9 || n === 10 || n === 13; }; + PRIMITIVES["char-upper-case?"] = function(c) { var n = c.codepoint; return n >= 65 && n <= 90; }; + PRIMITIVES["char-lower-case?"] = function(c) { var n = c.codepoint; return n >= 97 && n <= 122; }; + PRIMITIVES["string->list"] = function(s) { + var chars = []; var str = String(s); + for (var i = 0; i < str.length; i++) chars.push(makeChar(str.charCodeAt(i))); + return chars; + }; + PRIMITIVES["list->string"] = function(chars) { + return chars.map(function(c) { return String.fromCharCode(c.codepoint); }).join(''); + }; PRIMITIVES["string-length"] = function(s) { return String(s).length; }; var stringLength = PRIMITIVES["string-length"]; PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; }; @@ -1397,6 +1432,7 @@ PLATFORM_JS_PRE = ''' if (x._macro) return "macro"; if (x._raw) return "raw-html"; if (x._sx_expr) return "sx-expr"; + if (x._char) return "char"; if (x._vector) return "vector"; if (x._string_buffer) return "string-buffer"; if (x._hash_table) return "hash-table"; @@ -2045,6 +2081,9 @@ PLATFORM_PARSER_JS = r""" } function sxExprSource(e) { return typeof e === "string" ? e : (e && e.source ? e.source : String(e)); } var charFromCode = PRIMITIVES["char-from-code"]; + var makeChar = PRIMITIVES["make-char"]; + var charToInteger = PRIMITIVES["char->integer"]; + var isChar = PRIMITIVES["char?"]; """ diff --git a/hosts/javascript/transpiler.sx b/hosts/javascript/transpiler.sx index f0630ee8..4609b050 100644 --- a/hosts/javascript/transpiler.sx +++ b/hosts/javascript/transpiler.sx @@ -68,12 +68,14 @@ (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" :vector->list "vectorToList" :list->vector "listToVector" :vector? "isVector" :string->symbol "stringToSymbol" :symbol->string "symbolToString"}) +(define js-char-renames {:integer->char "integerToChar" :string->list "stringToList" :char? "isChar" :char->integer "charToInteger" :list->string "listToString"}) + (define js-mangle (fn ((name :as string)) (let - ((renamed (get js-renames name))) + ((renamed (or (get js-renames name) (get js-char-renames name)))) (if (not (nil? renamed)) renamed @@ -105,7 +107,10 @@ js-capitalize (fn ((s :as string)) - (if (empty? s) s (str (upper (slice s 0 1)) (slice s 1))))) + (if + (empty? s) + s + (str (upper (slice s 0 1)) (slice s 1))))) (define js-quote-string @@ -245,7 +250,10 @@ "\n" (map (fn (e) (js-statement e)) - (slice body-parts 0 (- (len body-parts) 1)))) + (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; }")) @@ -351,7 +359,9 @@ (str (join "\n" - (map (fn (e) (js-statement e)) (slice body 0 (- (len body) 1)))) + (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)))))) @@ -417,7 +427,10 @@ ((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"))) + (if + (>= (len args) 3) + (js-expr (nth args 2)) + "NIL"))) (str "(isSxTruthy(" cond-e ") ? " then-e " : " else-e ")")) (= op "when") (js-emit-when expr) @@ -569,7 +582,9 @@ (define js-collect-params - (fn ((params :as list)) (js-collect-params-loop params 0 (list) nil))) + (fn + ((params :as list)) + (js-collect-params-loop params 0 (list) nil))) (define js-collect-params-loop @@ -698,7 +713,12 @@ (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)) ";"))) + (str + " var " + (js-mangle vname) + " = " + (js-expr (nth b 1)) + ";"))) bindings) (js-parse-clojure-let-bindings bindings 0 (list)))))) @@ -786,7 +806,12 @@ ((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)) ";")))) + (str + "var " + (js-mangle vname) + " = " + (js-expr (nth b 1)) + ";")))) bindings) (js-append-clojure-bindings bindings parts 0))))) @@ -814,7 +839,8 @@ (fn (expr) (let - ((cond-e (js-expr (nth expr 1))) (body-parts (rest (rest expr)))) + ((cond-e (js-expr (nth expr 1))) + (body-parts (rest (rest expr)))) (if (= (len body-parts) 1) (str @@ -1000,7 +1026,9 @@ (define js-emit-dict-literal - (fn ((pairs :as list)) (str "{" (js-dict-pairs-str pairs 0 (list)) "}"))) + (fn + ((pairs :as list)) + (str "{" (js-dict-pairs-str pairs 0 (list)) "}"))) (define js-dict-pairs-str @@ -1102,7 +1130,11 @@ (js-expr (nth expr 3)) ";") (= name "append!") - (str (js-expr (nth expr 1)) ".push(" (js-expr (nth expr 2)) ");") + (str + (js-expr (nth expr 1)) + ".push(" + (js-expr (nth expr 2)) + ");") (= name "env-bind!") (str "envBind(" @@ -1178,7 +1210,8 @@ (fn (expr) (let - ((cond-e (js-expr (nth expr 1))) (body-parts (rest (rest expr)))) + ((cond-e (js-expr (nth expr 1))) + (body-parts (rest (rest expr)))) (str "if (isSxTruthy(" cond-e diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 89e7e912..9e699954 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -31,7 +31,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-05-01T10:26:58Z"; + var SX_VERSION = "2026-05-01T11:46:28Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -168,6 +168,7 @@ if (x._macro) return "macro"; if (x._raw) return "raw-html"; if (x._sx_expr) return "sx-expr"; + if (x._char) return "char"; if (x._vector) return "vector"; if (x._string_buffer) return "string-buffer"; if (x._hash_table) return "hash-table"; @@ -475,6 +476,41 @@ PRIMITIVES["slice"] = function(c, a, b) { if (!c || typeof c.slice !== "function") { console.error("[sx-debug] slice called on non-sliceable:", typeof c, c, "a=", a, "b=", b, new Error().stack); return []; } return b !== undefined ? c.slice(a, b) : c.slice(a); }; PRIMITIVES["substring"] = function(s, a, b) { return String(s).substring(a, b); }; PRIMITIVES["char-from-code"] = function(n) { return String.fromCharCode(n); }; + PRIMITIVES["char-code"] = function(s) { return String(s).charCodeAt(0); }; + var charCode = PRIMITIVES["char-code"]; + function makeChar(n) { return {_char: true, codepoint: n}; } + PRIMITIVES["make-char"] = makeChar; + var isChar = function(v) { return v != null && typeof v === "object" && v._char === true; }; + PRIMITIVES["char?"] = isChar; + var charToInteger = function(c) { return c.codepoint; }; + PRIMITIVES["char->integer"] = charToInteger; + var charUpcase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toUpperCase().charCodeAt(0)); }; + PRIMITIVES["char-upcase"] = charUpcase; + var charDowncase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toLowerCase().charCodeAt(0)); }; + PRIMITIVES["char-downcase"] = charDowncase; + PRIMITIVES["char=?"] = function(a, b) { return a.codepoint === b.codepoint; }; + PRIMITIVES["char?"] = function(a, b) { return a.codepoint > b.codepoint; }; + PRIMITIVES["char<=?"] = function(a, b) { return a.codepoint <= b.codepoint; }; + PRIMITIVES["char>=?"] = function(a, b) { return a.codepoint >= b.codepoint; }; + PRIMITIVES["char-ci=?"] = function(a, b) { return charDowncase(a).codepoint === charDowncase(b).codepoint; }; + PRIMITIVES["char-ci?"] = function(a, b) { return charDowncase(a).codepoint > charDowncase(b).codepoint; }; + PRIMITIVES["char-ci<=?"] = function(a, b) { return charDowncase(a).codepoint <= charDowncase(b).codepoint; }; + PRIMITIVES["char-ci>=?"] = function(a, b) { return charDowncase(a).codepoint >= charDowncase(b).codepoint; }; + PRIMITIVES["char-alphabetic?"] = function(c) { var n = c.codepoint; return (n >= 65 && n <= 90) || (n >= 97 && n <= 122); }; + PRIMITIVES["char-numeric?"] = function(c) { var n = c.codepoint; return n >= 48 && n <= 57; }; + PRIMITIVES["char-whitespace?"] = function(c) { var n = c.codepoint; return n === 32 || n === 9 || n === 10 || n === 13; }; + PRIMITIVES["char-upper-case?"] = function(c) { var n = c.codepoint; return n >= 65 && n <= 90; }; + PRIMITIVES["char-lower-case?"] = function(c) { var n = c.codepoint; return n >= 97 && n <= 122; }; + PRIMITIVES["string->list"] = function(s) { + var chars = []; var str = String(s); + for (var i = 0; i < str.length; i++) chars.push(makeChar(str.charCodeAt(i))); + return chars; + }; + PRIMITIVES["list->string"] = function(chars) { + return chars.map(function(c) { return String.fromCharCode(c.codepoint); }).join(''); + }; PRIMITIVES["string-length"] = function(s) { return String(s).length; }; var stringLength = PRIMITIVES["string-length"]; PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; }; @@ -1102,6 +1138,9 @@ } function sxExprSource(e) { return typeof e === "string" ? e : (e && e.source ? e.source : String(e)); } var charFromCode = PRIMITIVES["char-from-code"]; + var makeChar = PRIMITIVES["make-char"]; + var charToInteger = PRIMITIVES["char->integer"]; + var isChar = PRIMITIVES["char?"]; // String/number utilities needed by transpiled spec code (content-hash etc) @@ -3599,6 +3638,10 @@ PRIMITIVES["intern"] = intern; var symbolInterned_p = function(sym) { return true; }; PRIMITIVES["symbol-interned?"] = symbolInterned_p; + // integer->char + var integerToChar = makeChar; +PRIMITIVES["integer->char"] = integerToChar; + // === Transpiled from freeze (serializable state boundaries) === @@ -3901,6 +3944,21 @@ PRIMITIVES["raw-loop"] = rawLoop; return buf; })(); }; PRIMITIVES["read-raw-string"] = readRawString; + var readCharLiteral = function() { return (isSxTruthy((pos >= lenSrc)) ? error("Unexpected end of input after #\\") : (function() { + var firstCh = nth(source, pos); + return (isSxTruthy(isIdentStart(firstCh)) ? (function() { + var charStart = pos; + var readCharNameLoop = function() { while(true) { if (isSxTruthy((isSxTruthy((pos < lenSrc)) && isIdentChar(nth(source, pos))))) { pos = (pos + 1); +continue; } else { return NIL; } } }; +PRIMITIVES["read-char-name-loop"] = readCharNameLoop; + readCharNameLoop(); + return (function() { + var charName = slice(source, charStart, pos); + return makeChar((isSxTruthy(sxEq(charName, "space")) ? 32 : (isSxTruthy(sxEq(charName, "newline")) ? 10 : (isSxTruthy(sxEq(charName, "tab")) ? 9 : (isSxTruthy(sxEq(charName, "nul")) ? 0 : (isSxTruthy(sxEq(charName, "null")) ? 0 : (isSxTruthy(sxEq(charName, "return")) ? 13 : (isSxTruthy(sxEq(charName, "escape")) ? 27 : (isSxTruthy(sxEq(charName, "delete")) ? 127 : (isSxTruthy(sxEq(charName, "backspace")) ? 8 : (isSxTruthy(sxEq(charName, "altmode")) ? 27 : (isSxTruthy(sxEq(charName, "rubout")) ? 127 : charCode(firstCh))))))))))))); +})(); +})() : ((pos = (pos + 1)), makeChar(charCode(firstCh)))); +})()); }; +PRIMITIVES["read-char-literal"] = readCharLiteral; var readExpr = function() { while(true) { skipWs(); if (isSxTruthy((pos >= lenSrc))) { return error("Unexpected end of input"); } else { { var ch = nth(source, pos); if (isSxTruthy(sxEq(ch, "("))) { pos = (pos + 1); @@ -3916,7 +3974,8 @@ if (isSxTruthy(sxEq(dispatchCh, ";"))) { pos = (pos + 1); readExpr(); continue; } else if (isSxTruthy(sxEq(dispatchCh, "|"))) { pos = (pos + 1); return readRawString(); } else if (isSxTruthy(sxEq(dispatchCh, "'"))) { pos = (pos + 1); -return [makeSymbol("quote"), readExpr()]; } else if (isSxTruthy(isIdentStart(dispatchCh))) { { var macroName = readIdent(); +return [makeSymbol("quote"), readExpr()]; } else if (isSxTruthy(sxEq(dispatchCh, "\\"))) { pos = (pos + 1); +return readCharLiteral(); } else if (isSxTruthy(isIdentStart(dispatchCh))) { { var macroName = readIdent(); { var handler = readerMacroGet(macroName); if (isSxTruthy(handler)) { return handler(readExpr()); } else { return error((String("Unknown reader macro: #") + String(macroName))); } } } } else { return error((String("Unknown reader macro: #") + String(dispatchCh))); } } } } else if (isSxTruthy(sxOr((isSxTruthy((ch >= "0")) && (ch <= "9")), (isSxTruthy(sxEq(ch, "-")) && isSxTruthy(((pos + 1) < lenSrc)) && (function() { var nextCh = nth(source, (pos + 1)); @@ -3937,7 +3996,10 @@ PRIMITIVES["parse-loop"] = parseLoop; PRIMITIVES["sx-parse"] = sxParse; // sx-serialize - var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); return (String(val)); })(); }; + var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); if (_m == "char") return (function() { + var n = charToInteger(val); + return (String("#\\") + String((isSxTruthy(sxEq(n, 32)) ? "space" : (isSxTruthy(sxEq(n, 10)) ? "newline" : (isSxTruthy(sxEq(n, 9)) ? "tab" : (isSxTruthy(sxEq(n, 13)) ? "return" : (isSxTruthy(sxEq(n, 0)) ? "nul" : (isSxTruthy(sxEq(n, 27)) ? "escape" : (isSxTruthy(sxEq(n, 127)) ? "delete" : (isSxTruthy(sxEq(n, 8)) ? "backspace" : charFromCode(n))))))))))); +})(); return (String(val)); })(); }; PRIMITIVES["sx-serialize"] = sxSerialize; // sx-serialize-dict diff --git a/spec/evaluator.sx b/spec/evaluator.sx index cc254f44..6b0adae8 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -4776,3 +4776,5 @@ (define intern (fn (s) (make-symbol s))) (define symbol-interned? (fn (sym) true)) + +(define integer->char make-char) diff --git a/spec/parser.sx b/spec/parser.sx index 1189d90b..8f2a7f85 100644 --- a/spec/parser.sx +++ b/spec/parser.sx @@ -14,13 +14,14 @@ ;; list → '(' expr* ')' ;; vector → '[' expr* ']' (sugar for list) ;; map → '{' (key expr)* '}' -;; atom → string | number | keyword | symbol | boolean | nil +;; atom → string | number | keyword | symbol | boolean | nil | char ;; string → '"' (char | escape)* '"' ;; number → '-'? digit+ ('.' digit+)? ([eE] [+-]? digit+)? ;; keyword → ':' ident ;; symbol → ident ;; boolean → 'true' | 'false' ;; nil → 'nil' +;; char → '#\' (ident | single-char) ;; ident → ident-start ident-char* ;; comment → ';' to end of line (discarded) ;; @@ -34,6 +35,8 @@ ;; #;expr → datum comment (read and discard expr) ;; #|raw chars| → raw string literal (no escape processing) ;; #'expr → (quote expr) +;; #\a → character literal (char value) +;; #\space → named character (space = 32) ;; #name expr → extensible dispatch (calls registered handler) ;; ;; Platform interface (each target implements natively): @@ -42,6 +45,10 @@ ;; (make-symbol name) → Symbol value ;; (make-keyword name) → Keyword value ;; (escape-string s) → string with " and \ escaped for serialization +;; (make-char n) → Char value from Unicode codepoint +;; (char->integer c) → Unicode codepoint of char c +;; (char-from-code n) → single-char string from codepoint +;; (char-code s) → codepoint of first char in string s ;; ========================================================================== @@ -51,308 +58,416 @@ ;; Returns a list of top-level AST expressions. ;; Parse SX source string into AST -(define sx-parse :effects [] - (fn ((source :as string)) - (let ((pos 0) - (len-src (len source))) - - ;; -- Cursor helpers (closure over pos, source, len-src) -- - - (define skip-comment :effects [] - (fn () - (when (and (< pos len-src) (not (= (nth source pos) "\n"))) +(define + sx-parse + :effects () + (fn + ((source :as string)) + (let + ((pos 0) (len-src (len source))) + (define + skip-comment + :effects () + (fn + () + (when + (and (< pos len-src) (not (= (nth source pos) "\n"))) (set! pos (inc pos)) (skip-comment)))) - - (define skip-ws :effects [] - (fn () - (when (< pos len-src) - (let ((ch (nth source pos))) + (define + skip-ws + :effects () + (fn + () + (when + (< pos len-src) + (let + ((ch (nth source pos))) (cond - ;; Whitespace (or (= ch " ") (= ch "\t") (= ch "\n") (= ch "\r")) - (do (set! pos (inc pos)) (skip-ws)) - ;; Comment — skip to end of line + (do (set! pos (inc pos)) (skip-ws)) (= ch ";") - (do (set! pos (inc pos)) - (skip-comment) - (skip-ws)) - ;; Not whitespace or comment — stop + (do (set! pos (inc pos)) (skip-comment) (skip-ws)) :else nil))))) - - ;; -- Atom readers -- - - (define hex-digit-value :effects [] + (define + hex-digit-value + :effects () (fn (ch) (index-of "0123456789abcdef" (lower ch)))) - - (define read-string :effects [] - (fn () - (set! pos (inc pos)) ;; skip opening " - (let ((buf "")) - (define read-str-loop :effects [] - (fn () - (if (>= pos len-src) + (define + read-string + :effects () + (fn + () + (set! pos (inc pos)) + (let + ((buf "")) + (define + read-str-loop + :effects () + (fn + () + (if + (>= pos len-src) (error "Unterminated string") - (let ((ch (nth source pos))) + (let + ((ch (nth source pos))) (cond (= ch "\"") - (do (set! pos (inc pos)) nil) ;; done + (do (set! pos (inc pos)) nil) (= ch "\\") - (do (set! pos (inc pos)) - (let ((esc (nth source pos))) - (if (= esc "u") - ;; Unicode escape: \uXXXX → char - (do (set! pos (inc pos)) - (let ((d0 (hex-digit-value (nth source pos))) - (_ (set! pos (inc pos))) - (d1 (hex-digit-value (nth source pos))) - (_ (set! pos (inc pos))) - (d2 (hex-digit-value (nth source pos))) - (_ (set! pos (inc pos))) - (d3 (hex-digit-value (nth source pos))) - (_ (set! pos (inc pos)))) - (set! buf (str buf (char-from-code - (+ (* d0 4096) (* d1 256) (* d2 16) d3)))) - (read-str-loop))) - ;; Standard escapes: \n \t \r or literal - (do (set! buf (str buf - (cond - (= esc "n") "\n" - (= esc "t") "\t" - (= esc "r") "\r" - :else esc))) - (set! pos (inc pos)) - (read-str-loop))))) - :else - (do (set! buf (str buf ch)) - (set! pos (inc pos)) - (read-str-loop))))))) + (do + (set! pos (inc pos)) + (let + ((esc (nth source pos))) + (if + (= esc "u") + (do + (set! pos (inc pos)) + (let + ((d0 (hex-digit-value (nth source pos))) + (_ (set! pos (inc pos))) + (d1 (hex-digit-value (nth source pos))) + (_ (set! pos (inc pos))) + (d2 (hex-digit-value (nth source pos))) + (_ (set! pos (inc pos))) + (d3 (hex-digit-value (nth source pos))) + (_ (set! pos (inc pos)))) + (set! + buf + (str + buf + (char-from-code + (+ + (* d0 4096) + (* d1 256) + (* d2 16) + d3)))) + (read-str-loop))) + (do + (set! + buf + (str + buf + (cond + (= esc "n") + "\n" + (= esc "t") + "\t" + (= esc "r") + "\r" + :else esc))) + (set! pos (inc pos)) + (read-str-loop))))) + :else (do + (set! buf (str buf ch)) + (set! pos (inc pos)) + (read-str-loop))))))) (read-str-loop) buf))) - - (define read-ident :effects [] - (fn () - (let ((start pos)) - (define read-ident-loop :effects [] - (fn () - (when (and (< pos len-src) - (ident-char? (nth source pos))) + (define + read-ident + :effects () + (fn + () + (let + ((start pos)) + (define + read-ident-loop + :effects () + (fn + () + (when + (and (< pos len-src) (ident-char? (nth source pos))) (set! pos (inc pos)) (read-ident-loop)))) (read-ident-loop) (slice source start pos)))) - - (define read-keyword :effects [] - (fn () - (set! pos (inc pos)) ;; skip : - (make-keyword (read-ident)))) - - (define read-number :effects [] - (fn () - (let ((start pos)) - ;; Optional leading minus - (when (and (< pos len-src) (= (nth source pos) "-")) + (define + read-keyword + :effects () + (fn () (set! pos (inc pos)) (make-keyword (read-ident)))) + (define + read-number + :effects () + (fn + () + (let + ((start pos)) + (when + (and (< pos len-src) (= (nth source pos) "-")) (set! pos (inc pos))) - ;; Integer digits - (define read-digits :effects [] - (fn () - (when (and (< pos len-src) - (let ((c (nth source pos))) - (and (>= c "0") (<= c "9")))) + (define + read-digits + :effects () + (fn + () + (when + (and + (< pos len-src) + (let + ((c (nth source pos))) + (and (>= c "0") (<= c "9")))) (set! pos (inc pos)) (read-digits)))) (read-digits) - ;; Decimal part - (when (and (< pos len-src) (= (nth source pos) ".")) + (when + (and (< pos len-src) (= (nth source pos) ".")) (set! pos (inc pos)) (read-digits)) - ;; Exponent - (when (and (< pos len-src) - (or (= (nth source pos) "e") - (= (nth source pos) "E"))) + (when + (and + (< pos len-src) + (or (= (nth source pos) "e") (= (nth source pos) "E"))) (set! pos (inc pos)) - (when (and (< pos len-src) - (or (= (nth source pos) "+") - (= (nth source pos) "-"))) + (when + (and + (< pos len-src) + (or (= (nth source pos) "+") (= (nth source pos) "-"))) (set! pos (inc pos))) (read-digits)) (parse-number (slice source start pos))))) - - (define read-symbol :effects [] - (fn () - (let ((name (read-ident))) + (define + read-symbol + :effects () + (fn + () + (let + ((name (read-ident))) (cond - (= name "true") true - (= name "false") false - (= name "nil") nil - :else (make-symbol name))))) - - ;; -- Composite readers -- - - (define read-list :effects [] - (fn ((close-ch :as string)) - (let ((items (list))) - (define read-list-loop :effects [] - (fn () + (= name "true") + true + (= name "false") + false + (= name "nil") + nil + :else (make-symbol name))))) + (define + read-list + :effects () + (fn + ((close-ch :as string)) + (let + ((items (list))) + (define + read-list-loop + :effects () + (fn + () (skip-ws) - (if (>= pos len-src) + (if + (>= pos len-src) (error "Unterminated list") - (if (= (nth source pos) close-ch) - (do (set! pos (inc pos)) nil) ;; done - (do (append! items (read-expr)) - (read-list-loop)))))) + (if + (= (nth source pos) close-ch) + (do (set! pos (inc pos)) nil) + (do (append! items (read-expr)) (read-list-loop)))))) (read-list-loop) items))) - - (define read-map :effects [] - (fn () - (let ((result (dict))) - (define read-map-loop :effects [] - (fn () + (define + read-map + :effects () + (fn + () + (let + ((result (dict))) + (define + read-map-loop + :effects () + (fn + () (skip-ws) - (if (>= pos len-src) + (if + (>= pos len-src) (error "Unterminated map") - (if (= (nth source pos) "}") - (do (set! pos (inc pos)) nil) ;; done - (let ((key-expr (read-expr)) - (key-str (if (= (type-of key-expr) "keyword") - (keyword-name key-expr) - (str key-expr))) - (val-expr (read-expr))) + (if + (= (nth source pos) "}") + (do (set! pos (inc pos)) nil) + (let + ((key-expr (read-expr)) + (key-str + (if + (= (type-of key-expr) "keyword") + (keyword-name key-expr) + (str key-expr))) + (val-expr (read-expr))) (dict-set! result key-str val-expr) (read-map-loop)))))) (read-map-loop) result))) - - ;; -- Raw string reader (for #|...|) -- - - (define read-raw-string :effects [] - (fn () - (let ((buf "")) - (define raw-loop :effects [] - (fn () - (if (>= pos len-src) + (define + read-raw-string + :effects () + (fn + () + (let + ((buf "")) + (define + raw-loop + :effects () + (fn + () + (if + (>= pos len-src) (error "Unterminated raw string") - (let ((ch (nth source pos))) - (if (= ch "|") - (do (set! pos (inc pos)) nil) ;; done - (do (set! buf (str buf ch)) - (set! pos (inc pos)) - (raw-loop))))))) + (let + ((ch (nth source pos))) + (if + (= ch "|") + (do (set! pos (inc pos)) nil) + (do + (set! buf (str buf ch)) + (set! pos (inc pos)) + (raw-loop))))))) (raw-loop) buf))) - - ;; -- Main expression reader -- - - (define read-expr :effects [] - (fn () + (define + read-char-literal + :effects () + (fn + () + (if + (>= pos len-src) + (error "Unexpected end of input after #\\") + (let + ((first-ch (nth source pos))) + (if + (ident-start? first-ch) + (let + ((char-start pos)) + (define + read-char-name-loop + :effects () + (fn + () + (when + (and (< pos len-src) (ident-char? (nth source pos))) + (set! pos (inc pos)) + (read-char-name-loop)))) + (read-char-name-loop) + (let + ((char-name (slice source char-start pos))) + (make-char + (cond + (= char-name "space") + 32 + (= char-name "newline") + 10 + (= char-name "tab") + 9 + (= char-name "nul") + 0 + (= char-name "null") + 0 + (= char-name "return") + 13 + (= char-name "escape") + 27 + (= char-name "delete") + 127 + (= char-name "backspace") + 8 + (= char-name "altmode") + 27 + (= char-name "rubout") + 127 + :else (char-code first-ch))))) + (do (set! pos (inc pos)) (make-char (char-code first-ch)))))))) + (define + read-expr + :effects () + (fn + () (skip-ws) - (if (>= pos len-src) + (if + (>= pos len-src) (error "Unexpected end of input") - (let ((ch (nth source pos))) + (let + ((ch (nth source pos))) (cond - ;; Lists (= ch "(") - (do (set! pos (inc pos)) (read-list ")")) + (do (set! pos (inc pos)) (read-list ")")) (= ch "[") - (do (set! pos (inc pos)) (read-list "]")) - - ;; Map + (do (set! pos (inc pos)) (read-list "]")) (= ch "{") - (do (set! pos (inc pos)) (read-map)) - - ;; String + (do (set! pos (inc pos)) (read-map)) (= ch "\"") - (read-string) - - ;; Keyword + (read-string) (= ch ":") - (read-keyword) - - ;; Quote sugar + (read-keyword) (= ch "'") - (do (set! pos (inc pos)) - (list (make-symbol "quote") (read-expr))) - - ;; Quasiquote sugar + (do + (set! pos (inc pos)) + (list (make-symbol "quote") (read-expr))) (= ch "`") - (do (set! pos (inc pos)) - (list (make-symbol "quasiquote") (read-expr))) - - ;; Unquote / splice-unquote + (do + (set! pos (inc pos)) + (list (make-symbol "quasiquote") (read-expr))) (= ch ",") - (do (set! pos (inc pos)) - (if (and (< pos len-src) (= (nth source pos) "@")) - (do (set! pos (inc pos)) - (list (make-symbol "splice-unquote") (read-expr))) - (list (make-symbol "unquote") (read-expr)))) - - ;; Reader macros: # + (do + (set! pos (inc pos)) + (if + (and (< pos len-src) (= (nth source pos) "@")) + (do + (set! pos (inc pos)) + (list (make-symbol "splice-unquote") (read-expr))) + (list (make-symbol "unquote") (read-expr)))) (= ch "#") - (do (set! pos (inc pos)) - (if (>= pos len-src) - (error "Unexpected end of input after #") - (let ((dispatch-ch (nth source pos))) - (cond - ;; #; — datum comment: read and discard next expr - (= dispatch-ch ";") - (do (set! pos (inc pos)) - (read-expr) ;; read and discard - (read-expr)) ;; return the NEXT expr - - ;; #| — raw string - (= dispatch-ch "|") - (do (set! pos (inc pos)) - (read-raw-string)) - - ;; #' — quote shorthand - (= dispatch-ch "'") - (do (set! pos (inc pos)) - (list (make-symbol "quote") (read-expr))) - - ;; #name — extensible dispatch - (ident-start? dispatch-ch) - (let ((macro-name (read-ident))) - (let ((handler (reader-macro-get macro-name))) - (if handler - (handler (read-expr)) - (error (str "Unknown reader macro: #" macro-name))))) - - :else - (error (str "Unknown reader macro: #" dispatch-ch)))))) - - ;; Number (or negative number) - (or (and (>= ch "0") (<= ch "9")) - (and (= ch "-") - (< (inc pos) len-src) - (let ((next-ch (nth source (inc pos)))) - (and (>= next-ch "0") (<= next-ch "9"))))) - (read-number) - - ;; Ellipsis (... as a symbol) - (and (= ch ".") - (< (+ pos 2) len-src) - (= (nth source (+ pos 1)) ".") - (= (nth source (+ pos 2)) ".")) - (do (set! pos (+ pos 3)) - (make-symbol "...")) - - ;; Symbol (must be ident-start char) + (do + (set! pos (inc pos)) + (if + (>= pos len-src) + (error "Unexpected end of input after #") + (let + ((dispatch-ch (nth source pos))) + (cond + (= dispatch-ch ";") + (do (set! pos (inc pos)) (read-expr) (read-expr)) + (= dispatch-ch "|") + (do (set! pos (inc pos)) (read-raw-string)) + (= dispatch-ch "'") + (do + (set! pos (inc pos)) + (list (make-symbol "quote") (read-expr))) + (= dispatch-ch "\\") + (do (set! pos (inc pos)) (read-char-literal)) + (ident-start? dispatch-ch) + (let + ((macro-name (read-ident))) + (let + ((handler (reader-macro-get macro-name))) + (if + handler + (handler (read-expr)) + (error + (str "Unknown reader macro: #" macro-name))))) + :else (error (str "Unknown reader macro: #" dispatch-ch)))))) + (or + (and (>= ch "0") (<= ch "9")) + (and + (= ch "-") + (< (inc pos) len-src) + (let + ((next-ch (nth source (inc pos)))) + (and (>= next-ch "0") (<= next-ch "9"))))) + (read-number) + (and + (= ch ".") + (< (+ pos 2) len-src) + (= (nth source (+ pos 1)) ".") + (= (nth source (+ pos 2)) ".")) + (do (set! pos (+ pos 3)) (make-symbol "...")) (ident-start? ch) - (read-symbol) - - ;; Unexpected - :else - (error (str "Unexpected character: " ch))))))) - - ;; -- Entry point: parse all top-level expressions -- - (let ((exprs (list))) - (define parse-loop :effects [] - (fn () + (read-symbol) + :else (error (str "Unexpected character: " ch))))))) + (let + ((exprs (list))) + (define + parse-loop + :effects () + (fn + () (skip-ws) - (when (< pos len-src) - (append! exprs (read-expr)) - (parse-loop)))) + (when (< pos len-src) (append! exprs (read-expr)) (parse-loop)))) (parse-loop) exprs)))) @@ -362,30 +477,75 @@ ;; -------------------------------------------------------------------------- ;; Serialize AST value back to SX source -(define sx-serialize :effects [] - (fn (val) - (case (type-of val) - "nil" "nil" - "boolean" (if val "true" "false") - "number" (str val) - "string" (str "\"" (escape-string val) "\"") - "symbol" (symbol-name val) - "keyword" (str ":" (keyword-name val)) - "list" (str "(" (join " " (map sx-serialize val)) ")") - "dict" (sx-serialize-dict val) - "sx-expr" (sx-expr-source val) - "spread" (str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")") - :else (str val)))) +(define + sx-serialize + :effects () + (fn + (val) + (case + (type-of val) + "nil" + "nil" + "boolean" + (if val "true" "false") + "number" + (str val) + "string" + (str "\"" (escape-string val) "\"") + "symbol" + (symbol-name val) + "keyword" + (str ":" (keyword-name val)) + "list" + (str "(" (join " " (map sx-serialize val)) ")") + "dict" + (sx-serialize-dict val) + "sx-expr" + (sx-expr-source val) + "spread" + (str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")") + "char" + (let + ((n (char->integer val))) + (str + "#\\" + (cond + (= n 32) + "space" + (= n 10) + "newline" + (= n 9) + "tab" + (= n 13) + "return" + (= n 0) + "nul" + (= n 27) + "escape" + (= n 127) + "delete" + (= n 8) + "backspace" + :else (char-from-code n)))) + :else (str val)))) ;; Serialize a dict to SX {:key val} format -(define sx-serialize-dict :effects [] - (fn ((d :as dict)) - (str "{" - (join " " +(define + sx-serialize-dict + :effects () + (fn + ((d :as dict)) + (str + "{" + (join + " " (reduce - (fn ((acc :as list) (key :as string)) - (concat acc (list (str ":" key) (sx-serialize (dict-get d key))))) + (fn + ((acc :as list) (key :as string)) + (concat + acc + (list (str ":" key) (sx-serialize (dict-get d key))))) (list) (keys d))) "}"))) @@ -410,10 +570,14 @@ ;; (make-symbol name) → Symbol value ;; (make-keyword name) → Keyword value ;; (parse-number s) → number (int or float from string) +;; (make-char n) → Char value from Unicode codepoint n +;; (char->integer c) → Unicode codepoint of char c ;; ;; String utilities: ;; (escape-string s) → string with " and \ escaped ;; (sx-expr-source e) → unwrap SxExpr to its source string +;; (char-from-code n) → single-char string from codepoint n +;; (char-code s) → codepoint of first char in string s ;; ;; Reader macro registry: ;; (reader-macro-get name) → handler fn or nil diff --git a/spec/primitives.sx b/spec/primitives.sx index b47e0655..e5d3de46 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -492,6 +492,12 @@ :returns "string" :doc "Convert Unicode code point to single-character string.") +(define-primitive + "char-code" + :params ((s :as string)) + :returns "number" + :doc "Unicode codepoint of the first character of string s.") + (define-primitive "substring" :params ((s :as string) (start :as number) (end :as number)) @@ -546,15 +552,15 @@ :returns "boolean" :doc "True if string s starts with prefix.") +;; -------------------------------------------------------------------------- +;; Core — Dict operations +;; -------------------------------------------------------------------------- (define-primitive "ends-with?" :params ((s :as string) (suffix :as string)) :returns "boolean" :doc "True if string s ends with suffix.") -;; -------------------------------------------------------------------------- -;; Core — Dict operations -;; -------------------------------------------------------------------------- (define-module :core.collections) (define-primitive @@ -599,15 +605,15 @@ :returns "any" :doc "Last element, or nil if empty.") +;; -------------------------------------------------------------------------- +;; Stdlib — Format +;; -------------------------------------------------------------------------- (define-primitive "rest" :params ((coll :as list)) :returns "list" :doc "All elements except the first.") -;; -------------------------------------------------------------------------- -;; Stdlib — Format -;; -------------------------------------------------------------------------- (define-primitive "nth" :params ((coll :as list) (n :as number)) @@ -632,15 +638,15 @@ :returns "list" :doc "Mutate coll by appending x in-place. Returns coll.") +;; -------------------------------------------------------------------------- +;; Stdlib — Text +;; -------------------------------------------------------------------------- (define-primitive "reverse" :params ((coll :as list)) :returns "list" :doc "Return coll in reverse order.") -;; -------------------------------------------------------------------------- -;; Stdlib — Text -;; -------------------------------------------------------------------------- (define-primitive "flatten" :params ((coll :as list)) @@ -659,29 +665,29 @@ :returns "list" :doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).") -(define-module :core.dict) - ;; -------------------------------------------------------------------------- ;; Stdlib — Style ;; -------------------------------------------------------------------------- ;; -------------------------------------------------------------------------- ;; Stdlib — Debug ;; -------------------------------------------------------------------------- +(define-module :core.dict) + (define-primitive "keys" :params ((d :as dict)) :returns "list" :doc "List of dict keys.") +;; -------------------------------------------------------------------------- +;; Type introspection — platform primitives +;; -------------------------------------------------------------------------- (define-primitive "vals" :params ((d :as dict)) :returns "list" :doc "List of dict values.") -;; -------------------------------------------------------------------------- -;; Type introspection — platform primitives -;; -------------------------------------------------------------------------- (define-primitive "merge" :params (&rest (dicts :as dict)) diff --git a/spec/tests/test-chars.sx b/spec/tests/test-chars.sx new file mode 100644 index 00000000..b94b9aa7 --- /dev/null +++ b/spec/tests/test-chars.sx @@ -0,0 +1,185 @@ +;; Tests for character type (Phase 13) +;; Uses (make-char n) and (char-code "x") instead of #\x literals +;; (char literal parser syntax tested via sx-parse call) + +(deftest + "make-char produces a char" + (assert= true (char? (make-char 97)))) + +(deftest "char? false for string" (assert= false (char? "a"))) + +(deftest "char? false for number" (assert= false (char? 65))) + +(deftest "char? false for nil" (assert= false (char? nil))) + +(deftest + "char->integer extracts codepoint" + (assert= 97 (char->integer (make-char 97)))) + +(deftest + "integer->char alias for make-char" + (assert= 65 (char->integer (integer->char 65)))) + +(deftest + "char->integer round-trip" + (assert= 122 (char->integer (make-char 122)))) + +(deftest + "char=? equal" + (assert= true (char=? (make-char 97) (make-char 97)))) + +(deftest + "char=? unequal" + (assert= false (char=? (make-char 97) (make-char 98)))) + +(deftest + "char? ordering" + (assert= true (char>? (make-char 98) (make-char 97)))) + +(deftest + "char<=? equal" + (assert= true (char<=? (make-char 65) (make-char 65)))) + +(deftest + "char>=? greater" + (assert= true (char>=? (make-char 90) (make-char 65)))) + +(deftest + "char-ci=? ignores case (a vs A)" + (assert= true (char-ci=? (make-char 97) (make-char 65)))) + +(deftest + "char-ci? b > a case-insensitive" + (assert= true (char-ci>? (make-char 66) (make-char 65)))) + +(deftest + "char-alphabetic? true for a" + (assert= true (char-alphabetic? (make-char 97)))) + +(deftest + "char-alphabetic? true for Z" + (assert= true (char-alphabetic? (make-char 90)))) + +(deftest + "char-alphabetic? false for digit" + (assert= false (char-alphabetic? (make-char 48)))) + +(deftest + "char-numeric? true for 0" + (assert= true (char-numeric? (make-char 48)))) + +(deftest + "char-numeric? true for 9" + (assert= true (char-numeric? (make-char 57)))) + +(deftest + "char-numeric? false for letter" + (assert= false (char-numeric? (make-char 65)))) + +(deftest + "char-whitespace? true for space" + (assert= true (char-whitespace? (make-char 32)))) + +(deftest + "char-whitespace? true for newline" + (assert= true (char-whitespace? (make-char 10)))) + +(deftest + "char-whitespace? false for letter" + (assert= false (char-whitespace? (make-char 65)))) + +(deftest + "char-upper-case? true for A" + (assert= true (char-upper-case? (make-char 65)))) + +(deftest + "char-upper-case? false for a" + (assert= false (char-upper-case? (make-char 97)))) + +(deftest + "char-lower-case? true for a" + (assert= true (char-lower-case? (make-char 97)))) + +(deftest + "char-lower-case? false for A" + (assert= false (char-lower-case? (make-char 65)))) + +(deftest + "char-upcase converts a to A" + (assert= 65 (char->integer (char-upcase (make-char 97))))) + +(deftest + "char-downcase converts A to a" + (assert= + 97 + (char->integer (char-downcase (make-char 65))))) + +(deftest + "char-upcase idempotent on uppercase" + (assert= 65 (char->integer (char-upcase (make-char 65))))) + +(deftest + "string->list returns list of chars" + (assert= 3 (len (string->list "abc")))) + +(deftest + "string->list element 0 is char" + (assert= true (char? (get (string->list "abc") 0)))) + +(deftest + "string->list codepoints correct" + (assert= 97 (char->integer (get (string->list "abc") 0)))) + +(deftest + "list->string from chars produces string" + (assert= + "abc" + (list->string + (list + (make-char 97) + (make-char 98) + (make-char 99))))) + +(deftest + "string->list list->string round-trip" + (let ((s "hello")) (assert= s (list->string (string->list s))))) + +(deftest + "char literal parsed via sx-parse" + (let + ((ast (sx-parse "#\\a"))) + (assert= true (char? (get ast 0))))) + +(deftest + "char literal codepoint via sx-parse" + (let + ((ast (sx-parse "#\\a"))) + (assert= 97 (char->integer (get ast 0))))) + +(deftest + "named char space via sx-parse" + (let + ((ast (sx-parse "#\\space"))) + (assert= 32 (char->integer (get ast 0))))) + +(deftest + "named char newline via sx-parse" + (let + ((ast (sx-parse "#\\newline"))) + (assert= 10 (char->integer (get ast 0))))) + +(deftest + "char-ci<=? equal case-insensitive" + (assert= true (char-ci<=? (make-char 65) (make-char 97)))) + +(deftest + "char-ci>=? equal case-insensitive" + (assert= true (char-ci>=? (make-char 97) (make-char 65))))