giles
2d7dd7d582
Wraps all core .sx files in R7RS define-library with explicit export lists, plus (import ...) at end for backward-compatible global re-export. Libraries registered: (sx bytecode) — 83 opcode constants (sx render) — 15 tag registries + render helpers (sx signals) — 23 reactive signal primitives (sx r7rs) — 21 R7RS aliases (sx compiler) — 42 compiler functions (sx vm) — 32 VM functions (sx freeze) — 9 freeze/thaw functions (sx content) — 6 content store functions (sx callcc) — 1 call/cc wrapper (sx highlight) — 13 syntax highlighting functions (sx stdlib) — 47 stdlib functions (sx swap) — 13 swap algebra functions (sx render-trace) — 8 render trace functions (sx harness) — 21 test harness functions (sx canonical) — 12 canonical serialization functions (web adapter-html) — 13 HTML renderer functions (web adapter-sx) — 13 SX wire format functions (web engine) — 33 hypermedia engine functions (web request-handler) — 4 request handling functions (web page-helpers) — 12 page helper functions (web router) — 36 routing functions (web deps) — 19 dependency analysis functions (web orchestration) — 59 page orchestration functions Key changes: - define-library now inherits parent env (env-extend env instead of env-extend make-env) so library bodies can access platform primitives - sx_server.ml: added resolve_library_path + load_library_file for import resolution (maps library specs to file paths) - cek_run_with_io: handles "import" locally instead of sending to Python bridge 2608/2608 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
257 lines
11 KiB
Plaintext
257 lines
11 KiB
Plaintext
|
|
|
|
(define-library (web page-helpers)
|
|
(export
|
|
special-form-category-map
|
|
extract-define-kwargs
|
|
categorize-special-forms
|
|
build-ref-items-with-href
|
|
build-reference-data
|
|
build-attr-detail
|
|
build-header-detail
|
|
build-event-detail
|
|
build-component-source
|
|
build-bundle-analysis
|
|
build-routing-analysis
|
|
build-affinity-analysis)
|
|
(begin
|
|
|
|
(define special-form-category-map {:defmacro "Functions & Components" :for-each "Higher-Order Forms" :defpage "Domain Definitions" :let "Binding" :filter "Higher-Order Forms" :shift "Continuations" :and "Control Flow" :set! "Binding" :map-indexed "Higher-Order Forms" :dynamic-wind "Guards" :reduce "Higher-Order Forms" :cond "Control Flow" :defquery "Domain Definitions" :-> "Sequencing & Threading" :let* "Binding" :define "Binding" :reset "Continuations" :case "Control Flow" :do "Sequencing & Threading" :map "Higher-Order Forms" :some "Higher-Order Forms" :letrec "Binding" :if "Control Flow" :quote "Quoting" :every? "Higher-Order Forms" :defhandler "Domain Definitions" :fn "Functions & Components" :defstyle "Domain Definitions" :lambda "Functions & Components" :defaction "Domain Definitions" :or "Control Flow" :defcomp "Functions & Components" :quasiquote "Quoting" :when "Control Flow" :begin "Sequencing & Threading"})
|
|
|
|
(define
|
|
extract-define-kwargs
|
|
(fn
|
|
((expr :as list))
|
|
(let
|
|
((result {}) (items (slice expr 2)) (n (len items)))
|
|
(for-each
|
|
(fn
|
|
((idx :as number))
|
|
(when
|
|
(and (< (+ idx 1) n) (= (type-of (nth items idx)) "keyword"))
|
|
(let
|
|
((key (keyword-name (nth items idx)))
|
|
(val (nth items (+ idx 1))))
|
|
(dict-set!
|
|
result
|
|
key
|
|
(if
|
|
(= (type-of val) "list")
|
|
(str "(" (join " " (map serialize val)) ")")
|
|
(str val))))))
|
|
(range 0 n))
|
|
result)))
|
|
|
|
(define
|
|
categorize-special-forms
|
|
(fn
|
|
((parsed-exprs :as list))
|
|
(let
|
|
((categories {}))
|
|
(for-each
|
|
(fn
|
|
(expr)
|
|
(when
|
|
(and
|
|
(= (type-of expr) "list")
|
|
(>= (len expr) 2)
|
|
(= (type-of (first expr)) "symbol")
|
|
(= (symbol-name (first expr)) "define-special-form"))
|
|
(let
|
|
((name (nth expr 1))
|
|
(kwargs (extract-define-kwargs expr))
|
|
(category
|
|
(or
|
|
(get kwargs "category")
|
|
(get special-form-category-map name)
|
|
"Other")))
|
|
(when
|
|
(not (has-key? categories category))
|
|
(dict-set! categories category (list)))
|
|
(append! (get categories category) {:doc (or (get kwargs "doc") "") :example (or (get kwargs "example") "") :tail-position (or (get kwargs "tail-position") "") :syntax (or (get kwargs "syntax") "") :name name}))))
|
|
parsed-exprs)
|
|
categories)))
|
|
|
|
(define
|
|
build-ref-items-with-href
|
|
(fn
|
|
((items :as list)
|
|
(base-path :as string)
|
|
(detail-keys :as list)
|
|
(n-fields :as number))
|
|
(map
|
|
(fn
|
|
((item :as list))
|
|
(if
|
|
(= n-fields 3)
|
|
(let
|
|
((name (nth item 0))
|
|
(field2 (nth item 1))
|
|
(field3 (nth item 2)))
|
|
{:href (if (and field3 (some (fn ((k :as string)) (= k name)) detail-keys)) (str base-path name) nil) :exists field3 :desc field2 :name name})
|
|
(let ((name (nth item 0)) (desc (nth item 1))) {:href (if (some (fn ((k :as string)) (= k name)) detail-keys) (str base-path name) nil) :desc desc :name name})))
|
|
items)))
|
|
|
|
(define
|
|
build-reference-data
|
|
(fn
|
|
((slug :as string) (raw-data :as dict) (detail-keys :as list))
|
|
(case
|
|
slug
|
|
"attributes"
|
|
{:req-attrs (build-ref-items-with-href (get raw-data "req-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3) :beh-attrs (build-ref-items-with-href (get raw-data "beh-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3) :uniq-attrs (build-ref-items-with-href (get raw-data "uniq-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3)}
|
|
"headers"
|
|
{:req-headers (build-ref-items-with-href (get raw-data "req-headers") "/geography/hypermedia/reference/headers/" detail-keys 3) :resp-headers (build-ref-items-with-href (get raw-data "resp-headers") "/geography/hypermedia/reference/headers/" detail-keys 3)}
|
|
"events"
|
|
{:events-list (build-ref-items-with-href (get raw-data "events-list") "/geography/hypermedia/reference/events/" detail-keys 2)}
|
|
"js-api"
|
|
{:js-api-list (map (fn ((item :as list)) {:desc (nth item 1) :name (nth item 0)}) (get raw-data "js-api-list"))}
|
|
:else {:req-attrs (build-ref-items-with-href (get raw-data "req-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3) :beh-attrs (build-ref-items-with-href (get raw-data "beh-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3) :uniq-attrs (build-ref-items-with-href (get raw-data "uniq-attrs") "/geography/hypermedia/reference/attributes/" detail-keys 3)})))
|
|
|
|
(define
|
|
build-attr-detail
|
|
(fn ((slug :as string) detail) (if (nil? detail) {:attr-not-found true} {:attr-handler (get detail "handler") :attr-title slug :attr-example (get detail "example") :attr-not-found nil :attr-description (get detail "description") :attr-demo (get detail "demo") :attr-wire-id (if (has-key? detail "handler") (str "ref-wire-" (replace (replace slug ":" "-") "*" "star")) nil)})))
|
|
|
|
(define
|
|
build-header-detail
|
|
(fn ((slug :as string) detail) (if (nil? detail) {:header-not-found true} {:header-description (get detail "description") :header-demo (get detail "demo") :header-not-found nil :header-title slug :header-example (get detail "example") :header-direction (get detail "direction")})))
|
|
|
|
(define
|
|
build-event-detail
|
|
(fn ((slug :as string) detail) (if (nil? detail) {:event-not-found true} {:event-example (get detail "example") :event-demo (get detail "demo") :event-description (get detail "description") :event-not-found nil :event-title slug})))
|
|
|
|
(define
|
|
build-component-source
|
|
(fn
|
|
((comp-data :as dict))
|
|
(let
|
|
((comp-type (get comp-data "type"))
|
|
(name (get comp-data "name"))
|
|
(params (get comp-data "params"))
|
|
(has-children (get comp-data "has-children"))
|
|
(body-sx (get comp-data "body-sx"))
|
|
(affinity (get comp-data "affinity")))
|
|
(if
|
|
(= comp-type "not-found")
|
|
(str ";; component " name " not found")
|
|
(let
|
|
((param-strs (if (empty? params) (if has-children (list "&rest" "children") (list)) (if has-children (append (cons "&key" params) (list "&rest" "children")) (cons "&key" params))))
|
|
(params-sx (str "(" (join " " param-strs) ")"))
|
|
(form-name (if (= comp-type "island") "defisland" "defcomp"))
|
|
(affinity-str
|
|
(if
|
|
(and
|
|
(= comp-type "component")
|
|
(not (nil? affinity))
|
|
(not (= affinity "auto")))
|
|
(str " :affinity " affinity)
|
|
"")))
|
|
(str
|
|
"("
|
|
form-name
|
|
" "
|
|
name
|
|
" "
|
|
params-sx
|
|
affinity-str
|
|
"\n "
|
|
body-sx
|
|
")"))))))
|
|
|
|
(define
|
|
build-bundle-analysis
|
|
(fn
|
|
((pages-raw :as list)
|
|
(components-raw :as dict)
|
|
(total-components :as number)
|
|
(total-macros :as number)
|
|
(pure-count :as number)
|
|
(io-count :as number))
|
|
(let
|
|
((pages-data (list)))
|
|
(for-each
|
|
(fn
|
|
((page :as dict))
|
|
(let
|
|
((needed-names (get page "needed-names"))
|
|
(n (len needed-names))
|
|
(pct
|
|
(if
|
|
(> total-components 0)
|
|
(round (* (/ n total-components) 100))
|
|
0))
|
|
(savings (- 100 pct))
|
|
(pure-in-page 0)
|
|
(io-in-page 0)
|
|
(page-io-refs (list))
|
|
(comp-details (list)))
|
|
(for-each
|
|
(fn
|
|
((comp-name :as string))
|
|
(let
|
|
((info (get components-raw comp-name)))
|
|
(when
|
|
(not (nil? info))
|
|
(if
|
|
(get info "is-pure")
|
|
(set! pure-in-page (+ pure-in-page 1))
|
|
(do
|
|
(set! io-in-page (+ io-in-page 1))
|
|
(for-each
|
|
(fn
|
|
((ref :as string))
|
|
(when
|
|
(not
|
|
(some
|
|
(fn ((r :as string)) (= r ref))
|
|
page-io-refs))
|
|
(append! page-io-refs ref)))
|
|
(or (get info "io-refs") (list)))))
|
|
(append! comp-details {:io-refs (or (get info "io-refs") (list)) :render-target (get info "render-target") :deps (or (get info "deps") (list)) :source (get info "source") :name comp-name :is-pure (get info "is-pure") :affinity (get info "affinity")}))))
|
|
needed-names)
|
|
(append! pages-data {:pure-in-page pure-in-page :io-refs (len page-io-refs) :direct (get page "direct") :needed n :io-in-page io-in-page :components comp-details :savings savings :pct pct :path (get page "path") :name (get page "name")})))
|
|
pages-raw)
|
|
{:total-macros total-macros :pages pages-data :io-count io-count :pure-count pure-count :total-components total-components})))
|
|
|
|
(define
|
|
build-routing-analysis
|
|
(fn
|
|
((pages-raw :as list))
|
|
(let
|
|
((pages-data (list)) (client-count 0) (server-count 0))
|
|
(for-each
|
|
(fn
|
|
((page :as dict))
|
|
(let
|
|
((has-data (not (nil? (get page "data"))))
|
|
(content-src (or (get page "content-src") ""))
|
|
(mode nil)
|
|
(reason ""))
|
|
(cond
|
|
has-data
|
|
(do
|
|
(set! mode "server")
|
|
(set! reason "Has :data expression — needs server IO")
|
|
(set! server-count (+ server-count 1)))
|
|
(empty? content-src)
|
|
(do
|
|
(set! mode "server")
|
|
(set! reason "No content expression")
|
|
(set! server-count (+ server-count 1)))
|
|
:else (do
|
|
(set! mode "client")
|
|
(set! client-count (+ client-count 1))))
|
|
(append! pages-data {:reason reason :mode mode :content-expr (if (> (len content-src) 80) (str (slice content-src 0 80) "...") content-src) :has-data has-data :path (get page "path") :name (get page "name")})))
|
|
pages-raw)
|
|
{:pages pages-data :total-pages (+ client-count server-count) :server-count server-count :client-count client-count})))
|
|
|
|
(define
|
|
build-affinity-analysis
|
|
(fn ((demo-components :as list) (page-plans :as list)) {:components demo-components :page-plans page-plans}))
|
|
|
|
|
|
)) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (web page-helpers))
|