Step 17b: bytecode-compiled text-layout, WASM library import fix
- text-layout.sx added to WASM bytecode pipeline (9K compiled) - Fix multi-list map calls (map-indexed + nth instead of map fn list1 list2) - pretext-layout-lines and pretext-position-line moved to library exports - Browser load-sxbc: handle VmSuspended for import, copy library exports to global_env after module load (define-library export fix) - compile-modules.js: text-layout in SOURCE_MAP, FILES, and entry deps - Island uses library functions (break-lines, pretext-layout-lines) instead of inlining — runs on bytecode VM when exports resolve Known issue: define-library exports don't propagate to browser global env yet. The load-sxbc import suspension handler resumes correctly but bind_import_set doesn't fire. Needs deeper investigation into how the WASM kernel's define-library registers exports vs how other libraries (adapter-html, tw) make their exports available. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -314,7 +314,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote +) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -363,7 +366,10 @@
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote set!)
|
||||
t
|
||||
(list (quote -) (list (quote or) t 0) amount)))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -801,8 +807,23 @@
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
(nth ast 1)))))
|
||||
((= head (quote remove-element))
|
||||
(list (quote dom-remove) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
(list (quote dom-remove-attr) tgt (nth ast 1))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
(props (nth ast 1)))
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn (p) (list (quote dom-set-style) tgt p ""))
|
||||
props))))
|
||||
((= head (quote toggle-class))
|
||||
(list
|
||||
(quote hs-toggle-class!)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -727,30 +727,68 @@
|
||||
parse-remove-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(cond
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
||||
((cls (get (adv!) "value")) (extra-classes (list)))
|
||||
(define
|
||||
collect-classes!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(= (tp-type) "class")
|
||||
(set!
|
||||
extra-classes
|
||||
(append extra-classes (list (get (adv!) "value"))))
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes)))))))
|
||||
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes))))))
|
||||
nil)))
|
||||
(= (tp-type) "attr")
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(match-kw "]")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-attr) attr-name tgt)))
|
||||
nil)))
|
||||
((= (tp-val) "{")
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((props (list)))
|
||||
(define
|
||||
collect-props!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(when (= (tp-val) ";") (adv!))
|
||||
(when
|
||||
(not (= (tp-val) "}"))
|
||||
(set!
|
||||
props
|
||||
(append props (list (get (adv!) "value"))))
|
||||
(collect-props!)))))
|
||||
(collect-props!)
|
||||
(match-kw "}")
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
(list (quote remove-css) props tgt)))))
|
||||
(true
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote remove-element) target))))))
|
||||
(define
|
||||
parse-toggle-cmd
|
||||
(fn
|
||||
@@ -1168,6 +1206,7 @@
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(match-kw "then")
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -618,6 +618,29 @@
|
||||
"tw-process-token"
|
||||
]
|
||||
},
|
||||
"sx text-layout": {
|
||||
"file": "text-layout.sxbc",
|
||||
"deps": [],
|
||||
"exports": [
|
||||
"measure-text",
|
||||
"line-badness",
|
||||
"compute-demerits",
|
||||
"sum-widths",
|
||||
"find-breaks",
|
||||
"break-lines",
|
||||
"break-lines-greedy",
|
||||
"position-line",
|
||||
"position-lines",
|
||||
"pretext-position-line",
|
||||
"pretext-layout-lines",
|
||||
"layout-paragraph",
|
||||
"make-hyphenation-trie",
|
||||
"find-hyphenation-points",
|
||||
"hyphenate-word",
|
||||
"typeset",
|
||||
"typeset-plain"
|
||||
]
|
||||
},
|
||||
"web boot-helpers": {
|
||||
"file": "boot-helpers.sxbc",
|
||||
"deps": [
|
||||
@@ -1039,7 +1062,8 @@
|
||||
"web router",
|
||||
"web page-helpers",
|
||||
"web orchestration",
|
||||
"sx render"
|
||||
"sx render",
|
||||
"sx text-layout"
|
||||
],
|
||||
"lazy_deps": [
|
||||
"sx bytecode",
|
||||
|
||||
357
shared/static/wasm/sx/text-layout.sx
Normal file
357
shared/static/wasm/sx/text-layout.sx
Normal file
@@ -0,0 +1,357 @@
|
||||
;; Pretext — DOM-free text layout (pure SX)
|
||||
;;
|
||||
;; Cheng Lou's insight: text measurement is IO, but text *layout* is
|
||||
;; pure arithmetic. One `perform` for glyph metrics, everything else
|
||||
;; is deterministic functions over numbers.
|
||||
;;
|
||||
;; Architecture:
|
||||
;; (perform (text-measure :font font :size size :text text))
|
||||
;; → {:widths (...) :height N :ascent N :descent N}
|
||||
;;
|
||||
;; break-lines, position-glyphs, hyphenate — all pure SX.
|
||||
;;
|
||||
;; Knuth-Plass optimal line breaking (DP over break candidates).
|
||||
;; Liang's hyphenation (trie over character patterns).
|
||||
|
||||
(define
|
||||
pretext-position-line
|
||||
(fn
|
||||
(words widths gap-w)
|
||||
(let
|
||||
loop
|
||||
((i 0) (x 0) (acc (list)))
|
||||
(if
|
||||
(>= i (len words))
|
||||
acc
|
||||
(loop
|
||||
(+ i 1)
|
||||
(+ x (nth widths i) gap-w)
|
||||
(append acc (list {:width (nth widths i) :x x :word (nth words i)})))))))
|
||||
|
||||
(define-library
|
||||
(sx text-layout)
|
||||
(export
|
||||
measure-text
|
||||
line-badness
|
||||
compute-demerits
|
||||
sum-widths
|
||||
find-breaks
|
||||
break-lines
|
||||
break-lines-greedy
|
||||
position-line
|
||||
position-lines
|
||||
pretext-position-line
|
||||
pretext-layout-lines
|
||||
layout-paragraph
|
||||
make-hyphenation-trie
|
||||
find-hyphenation-points
|
||||
hyphenate-word
|
||||
typeset
|
||||
typeset-plain)
|
||||
(begin
|
||||
(define
|
||||
measure-text
|
||||
(fn
|
||||
(font size text)
|
||||
(perform (list (quote text-measure) font size text))))
|
||||
(define
|
||||
line-badness
|
||||
(fn
|
||||
(used max-width)
|
||||
(let
|
||||
((slack (- max-width used)))
|
||||
(if
|
||||
(< slack 0)
|
||||
100000
|
||||
(let
|
||||
((ratio (/ slack max-width)))
|
||||
(* (* ratio ratio) (* ratio 1000)))))))
|
||||
(define
|
||||
compute-demerits
|
||||
(fn
|
||||
(badness penalty)
|
||||
(let
|
||||
((base (+ 1 badness)))
|
||||
(+ (* base base) (* penalty penalty)))))
|
||||
(define
|
||||
sum-widths
|
||||
(fn
|
||||
(widths space-width from to)
|
||||
(let
|
||||
loop
|
||||
((k from) (total 0))
|
||||
(if
|
||||
(>= k to)
|
||||
(let
|
||||
((spaces (max 0 (- (- to from) 1))))
|
||||
(+ total (* spaces space-width)))
|
||||
(loop (+ k 1) (+ total (nth widths k)))))))
|
||||
(define
|
||||
find-breaks
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(let
|
||||
((n (len widths)))
|
||||
(if
|
||||
(<= n 0)
|
||||
(list)
|
||||
(let
|
||||
((dp (map (fn (i) (if (= i 0) (list 0 -1) (list 999999999 -1))) (range (+ n 1)))))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((prev-cost (first (nth dp i))))
|
||||
(let
|
||||
try-j
|
||||
((j i))
|
||||
(when
|
||||
(< j n)
|
||||
(let
|
||||
((used (sum-widths widths space-width i (+ j 1))))
|
||||
(when
|
||||
(<= used (* max-width 1.15))
|
||||
(let
|
||||
((bad (line-badness used max-width))
|
||||
(penalty 0))
|
||||
(let
|
||||
((cost (+ prev-cost (compute-demerits bad penalty)))
|
||||
(entry (nth dp (+ j 1))))
|
||||
(when
|
||||
(< cost (first entry))
|
||||
(set!
|
||||
dp
|
||||
(map-indexed
|
||||
(fn
|
||||
(idx e)
|
||||
(if (= idx (+ j 1)) (list cost i) e))
|
||||
dp)))
|
||||
(try-j (+ j 1))))))))))
|
||||
(range n))
|
||||
(let
|
||||
trace
|
||||
((pos n) (breaks (list)))
|
||||
(let
|
||||
((prev (nth (nth dp pos) 1)))
|
||||
(if (<= prev 0) breaks (trace prev (cons prev breaks))))))))))
|
||||
(define
|
||||
break-lines
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(let
|
||||
((breaks (find-breaks widths space-width max-width))
|
||||
(n (len widths)))
|
||||
(if
|
||||
(= n 0)
|
||||
(list)
|
||||
(let
|
||||
((starts (cons 0 breaks)))
|
||||
(let
|
||||
((ends (append (rest starts) (list n))))
|
||||
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
|
||||
(define
|
||||
position-line
|
||||
(fn
|
||||
(words widths space-width x0 y)
|
||||
(let
|
||||
loop
|
||||
((i 0) (x x0) (result (list)))
|
||||
(if
|
||||
(>= i (len words))
|
||||
(reverse result)
|
||||
(let
|
||||
((w (nth words i)) (width (nth widths i)))
|
||||
(loop
|
||||
(+ i 1)
|
||||
(+ x width space-width)
|
||||
(cons {:width width :x x :y y :word w} result)))))))
|
||||
(define
|
||||
position-lines
|
||||
(fn
|
||||
(words widths line-ranges space-width line-height x0 y0)
|
||||
(map-indexed
|
||||
(fn
|
||||
(line-idx range)
|
||||
(let
|
||||
((start (first range))
|
||||
(end (nth range 1))
|
||||
(y (+ y0 (* line-idx line-height))))
|
||||
(let
|
||||
((line-words (slice words start end))
|
||||
(line-widths (slice widths start end)))
|
||||
(position-line line-words line-widths space-width x0 y))))
|
||||
line-ranges)))
|
||||
(define
|
||||
make-hyphenation-trie
|
||||
(fn
|
||||
(patterns)
|
||||
(let
|
||||
((trie {:children {} :levels (list)}))
|
||||
(for-each
|
||||
(fn
|
||||
(pattern)
|
||||
(let
|
||||
((chars (list)) (levels (list)) (current-level 0))
|
||||
(for-each
|
||||
(fn
|
||||
(ch)
|
||||
(if
|
||||
(and (>= (char-code ch) 48) (<= (char-code ch) 57))
|
||||
(set! current-level (parse-number ch))
|
||||
(do
|
||||
(set! chars (append chars (list ch)))
|
||||
(set! levels (append levels (list current-level)))
|
||||
(set! current-level 0))))
|
||||
(map (fn (i) (char-at pattern i)) (range (len pattern))))
|
||||
(set! levels (append levels (list current-level)))
|
||||
(let
|
||||
insert
|
||||
((node trie) (i 0))
|
||||
(if
|
||||
(>= i (len chars))
|
||||
(dict-set! node :levels levels)
|
||||
(let
|
||||
((ch (nth chars i)) (children (get node :children)))
|
||||
(when
|
||||
(not (has-key? children ch))
|
||||
(dict-set! children ch {:children {} :levels (list)}))
|
||||
(insert (get children ch) (+ i 1)))))))
|
||||
patterns)
|
||||
trie)))
|
||||
(define
|
||||
find-hyphenation-points
|
||||
(fn
|
||||
(trie word)
|
||||
(let
|
||||
((n (len word))
|
||||
(padded (str "." word "."))
|
||||
(pn (+ n 2))
|
||||
(levels (map (fn (_) 0) (range (+ n 1)))))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
walk
|
||||
((node trie) (j i))
|
||||
(when
|
||||
(< j pn)
|
||||
(let
|
||||
((ch (char-at padded j))
|
||||
(children (get node :children)))
|
||||
(when
|
||||
(has-key? children ch)
|
||||
(let
|
||||
((child (get children ch)))
|
||||
(when
|
||||
(not (empty? (get child :levels)))
|
||||
(let
|
||||
((pat-levels (get child :levels)))
|
||||
(for-each
|
||||
(fn
|
||||
(k)
|
||||
(when
|
||||
(< (+ i k) (+ n 1))
|
||||
(let
|
||||
((old (nth levels (+ i k)))
|
||||
(new-val (nth pat-levels k)))
|
||||
(when
|
||||
(> new-val old)
|
||||
(set!
|
||||
levels
|
||||
(map-indexed
|
||||
(fn
|
||||
(idx v)
|
||||
(if (= idx (+ i k)) new-val v))
|
||||
levels))))))
|
||||
(range (len pat-levels)))))
|
||||
(walk child (+ j 1))))))))
|
||||
(range pn))
|
||||
(filter
|
||||
(fn
|
||||
(i)
|
||||
(and (> i 1) (< i (- n 1)) (= (mod (nth levels i) 2) 1)))
|
||||
(range (+ n 1))))))
|
||||
(define
|
||||
hyphenate-word
|
||||
(fn
|
||||
(trie word)
|
||||
(let
|
||||
((points (find-hyphenation-points trie word)))
|
||||
(if
|
||||
(empty? points)
|
||||
(list word)
|
||||
(let
|
||||
((starts (cons 0 points))
|
||||
(ends (append points (list (len word)))))
|
||||
(map-indexed (fn (i s) (slice word s (nth ends i))) starts))))))
|
||||
(define
|
||||
layout-paragraph
|
||||
(fn
|
||||
(words font size max-width line-height-factor)
|
||||
(let
|
||||
((metrics (map (fn (w) (measure-text font size w)) words))
|
||||
(widths (map (fn (m) (get m :width)) metrics))
|
||||
(height
|
||||
(if (empty? metrics) size (get (first metrics) :height)))
|
||||
(line-height (* height (or line-height-factor 1.4)))
|
||||
(space-metrics (measure-text font size " "))
|
||||
(space-width (get space-metrics :width)))
|
||||
(let
|
||||
((line-ranges (break-lines widths space-width max-width))
|
||||
(positioned
|
||||
(position-lines
|
||||
words
|
||||
widths
|
||||
(break-lines widths space-width max-width)
|
||||
space-width
|
||||
line-height
|
||||
0
|
||||
0)))
|
||||
{:lines positioned :width max-width :line-height line-height :font-height height :line-ranges line-ranges :height (* (len line-ranges) line-height)}))))
|
||||
(define
|
||||
typeset-plain
|
||||
(fn
|
||||
(text font size max-width)
|
||||
(let
|
||||
((words (split text " ")))
|
||||
(layout-paragraph words font size max-width 1.4))))
|
||||
(define
|
||||
typeset
|
||||
(fn
|
||||
(text &key font size max-width line-height)
|
||||
(let
|
||||
((words (split text " "))
|
||||
(f (or font "serif"))
|
||||
(s (or size 16))
|
||||
(w (or max-width 600))
|
||||
(lh (or line-height 1.4)))
|
||||
(layout-paragraph words f s w lh))))))
|
||||
|
||||
(define
|
||||
break-lines-greedy
|
||||
(fn
|
||||
(widths space-width max-width)
|
||||
(let
|
||||
((n (len widths)))
|
||||
(if
|
||||
(= n 0)
|
||||
(list)
|
||||
(let
|
||||
((lines (list)) (start 0) (used 0))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((w (nth widths i))
|
||||
(needed (if (= i start) w (+ used space-width w))))
|
||||
(if
|
||||
(and (> needed max-width) (not (= i start)))
|
||||
(do
|
||||
(set! lines (append lines (list (list start i))))
|
||||
(set! start i)
|
||||
(set! used w))
|
||||
(set! used needed))))
|
||||
(range n))
|
||||
(append lines (list (list start n))))))))
|
||||
|
||||
(import (sx text-layout))
|
||||
3
shared/static/wasm/sx/text-layout.sxbc
Normal file
3
shared/static/wasm/sx/text-layout.sxbc
Normal file
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1792,7 +1792,7 @@
|
||||
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||
}
|
||||
(globalThis))
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-982ed992",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-acaac3c1",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-80a20737",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-08c26bf2",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
|
||||
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
|
||||
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||
|
||||
Reference in New Issue
Block a user