Fix Pretext island: library functions inside define-library begin block

Root cause: sx_insert_near placed break-lines-greedy, pretext-position-line,
pretext-layout-lines OUTSIDE the define-library begin block. The bytecode
compiler only compiles forms inside begin as STORE_GLOBAL — forms outside
are invisible to the browser VM.

Fix: moved all function definitions inside (begin ...) of (define-library).
Bytecode now includes all 17 functions (11K compiled, was 9K).

Browser load-sxbc: simplified VmSuspended handling — just catch and
continue, since STORE_GLOBAL ops already ran before the import OP_PERFORM.
sync_vm_to_env copies them to global_env.

Island now calls break-lines and pretext-layout-lines from bytecode-compiled
library — runs on VM, not CEK interpreter.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-12 17:53:50 +00:00
parent 45209caf73
commit 7ec42386fb
14 changed files with 275 additions and 316 deletions

View File

@@ -688,42 +688,12 @@ let () =
(* Use execute_module_safe to handle import suspension.
Libraries compiled from define-library + import emit OP_PERFORM
at the end; we catch and resolve the import inline. *)
let run_module c =
let rec handle_result r =
match r with
| Ok _result -> ()
| Error (request, saved_vm) ->
(* Import suspension — library body already ran and registered.
Copy exports to global env, then resume the VM. *)
let lib_spec = Sx_runtime.get_val request (String "library") in
(try ignore (Sx_ref.bind_import_set lib_spec (Env global_env))
with _ -> ());
let next = try Ok (Sx_vm.resume_vm saved_vm Nil)
with Sx_vm.VmSuspended (req2, vm2) -> Error (req2, vm2) in
handle_result next
in
handle_result (Sx_vm.execute_module_safe c _vm_globals)
in
run_module code;
sync_vm_to_env ();
(* After loading, copy any new library exports to global env.
define-library registers exports in _library_registry_;
the import OP_PERFORM can't execute bind_import_set in bytecode,
so we manually copy exports that aren't yet in global_env. *)
(match Sx_ref._library_registry_ with
| Dict registry ->
Hashtbl.iter (fun _key entry ->
(match Sx_runtime.get_val entry (String "exports") with
| Dict exports ->
Hashtbl.iter (fun name value ->
if not (Sx_types.env_has global_env name) then begin
ignore (Sx_types.env_bind global_env name value);
Hashtbl.replace _vm_globals name value
end
) exports
| _ -> ())
) registry
(try
ignore (Sx_vm.execute_module code _vm_globals)
with
| Sx_vm.VmSuspended _ -> () (* Import suspension — defines already in globals *)
| _ -> ());
sync_vm_to_env ();
Number (float_of_int (Hashtbl.length _vm_globals))
| _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));

View File

@@ -13,21 +13,6 @@
;; 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
@@ -149,6 +134,32 @@
(let
((ends (append (rest starts) (list n))))
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
(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))))))))
(define
position-line
(fn
@@ -181,6 +192,45 @@
(line-widths (slice widths start end)))
(position-line line-words line-widths space-width x0 y))))
line-ranges)))
(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
pretext-layout-lines
(fn
(words widths ranges space-width max-width line-height)
(let
((n-lines (len ranges)))
(map
(fn
(line-idx)
(let
((range (nth ranges line-idx))
(y (* line-idx line-height)))
(let
((start (first range)) (end (nth range 1)))
(let
((lw (slice words start end))
(lwid (slice widths start end)))
(let
((total-w (reduce + 0 lwid))
(n-gaps (max 1 (- (len lw) 1)))
(is-last (= line-idx (- n-lines 1))))
(let
((gap (if is-last space-width (/ (- max-width total-w) n-gaps))))
{:y y :words (pretext-position-line lw lwid gap)}))))))
(range n-lines)))))
(define
make-hyphenation-trie
(fn
@@ -327,31 +377,4 @@
(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))

View File

@@ -240,18 +240,22 @@
((prop (nth ast 1)) (value (hs-to-sx (nth ast 2))))
(if
(= (len ast) 5)
(list
(quote hs-transition)
(hs-to-sx (nth ast 4))
prop
value
(nth ast 3))
(list
(quote hs-transition)
(hs-to-sx (nth ast 3))
prop
value
nil)))))
(let
((raw-tgt (nth ast 4)))
(list
(quote hs-transition)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
value
(nth ast 3)))
(let
((raw-tgt (nth ast 3)))
(list
(quote hs-transition)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
value
nil))))))
(define
emit-make
(fn
@@ -913,6 +917,19 @@
(list (quote dom-set-style) tgt "visibility" "visible"))
(true (list (quote dom-set-style) tgt "display" "")))))
((= head (quote transition)) (emit-transition ast))
((= head (quote transition-from))
(let
((prop (nth ast 1))
(from-val (hs-to-sx (nth ast 2)))
(to-val (hs-to-sx (nth ast 3)))
(dur (nth ast 4)))
(list
(quote hs-transition-from)
(quote me)
prop
from-val
to-val
dur)))
((= head (quote repeat)) (emit-repeat ast))
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))

File diff suppressed because one or more lines are too long

View File

@@ -1011,18 +1011,21 @@
(fn
()
(let
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((and (= (tp-val) "my") (= (get (nth tokens (+ p 1)) "type") "style")) (do (adv!) (get (adv!) "value"))) (true (get (adv!) "value")))))
(expect-kw! "to")
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((= (tp-val) "my") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) (true (get (adv!) "value")))))
(let
((value (parse-expr)))
((from-val (if (match-kw "from") (parse-expr) nil)))
(expect-kw! "to")
(let
((dur (if (match-kw "over") (parse-expr) nil)))
((value (parse-expr)))
(let
((tgt nil))
((dur (if (match-kw "over") (parse-expr) nil)))
(if
dur
(list (quote transition) prop value dur tgt)
(list (quote transition) prop value tgt))))))))
from-val
(list (quote transition-from) prop from-val value dur)
(if
dur
(list (quote transition) prop value dur nil)
(list (quote transition) prop value nil)))))))))
(define
parse-repeat-cmd
(fn

File diff suppressed because one or more lines are too long

View File

@@ -344,6 +344,20 @@
(dom-set-style target prop value)
(when duration (hs-settle target))))
(define
hs-transition-from
(fn
(target prop from-val to-val duration)
(dom-set-style target prop (str from-val))
(when
duration
(dom-set-style
target
"transition"
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop (str to-val))
(when duration (hs-settle target))))
(define
hs-type-check
(fn
@@ -359,20 +373,21 @@
((= type-name "Object") (dict? value))
(true true)))))
(define
hs-type-check-strict
(fn
(value type-name)
(if (nil? value) false (hs-type-check value type-name))))
(define
hs-strict-eq
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-falsy?
(fn
@@ -384,8 +399,7 @@
((and (list? v) (= (len v) 0)) true)
((= v 0) true)
(true false))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; DOM query stub — sandbox returns empty list
(define
hs-matches?
(fn
@@ -394,7 +408,7 @@
(string? target)
(if (= pattern ".*") true (string-contains? target pattern))
false)))
;; DOM query stub — sandbox returns empty list
;; Method dispatch — obj.method(args)
(define
hs-contains?
(fn
@@ -414,11 +428,11 @@
true
(hs-contains? (rest collection) item)))))
(true false))))
;; Method dispatch — obj.method(args)
(define precedes? (fn (a b) (< (str a) (str b))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define precedes? (fn (a b) (< (str a) (str b))))
;; Property-based is — check obj.key truthiness
(define
hs-empty?
(fn
@@ -429,11 +443,11 @@
((list? v) (= (len v) 0))
((dict? v) (= (len (keys v)) 0))
(true false))))
;; Property-based is — check obj.key truthiness
(define hs-first (fn (lst) (first lst)))
;; Array slicing (inclusive both ends)
(define hs-last (fn (lst) (last lst)))
(define hs-first (fn (lst) (first lst)))
;; Collection: sorted by
(define hs-last (fn (lst) (last lst)))
;; Collection: sorted by descending
(define
hs-template
(fn
@@ -519,7 +533,7 @@
(set! i (+ i 1))
(tpl-loop)))))))
(do (tpl-loop) result))))
;; Collection: sorted by descending
;; Collection: split by
(define
hs-make-object
(fn
@@ -531,7 +545,7 @@
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
pairs)
d))))
;; Collection: split by
;; Collection: joined by
(define
hs-method-call
(fn
@@ -554,7 +568,7 @@
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
;; Collection: joined by
(define hs-beep (fn (v) v))
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))

File diff suppressed because one or more lines are too long

View File

@@ -1011,6 +1011,7 @@
"hs-install",
"hs-measure",
"hs-transition",
"hs-transition-from",
"hs-type-check",
"hs-type-check-strict",
"hs-strict-eq",

View File

@@ -13,21 +13,6 @@
;; 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
@@ -149,6 +134,32 @@
(let
((ends (append (rest starts) (list n))))
(map-indexed (fn (i s) (list s (nth ends i))) starts)))))))
(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))))))))
(define
position-line
(fn
@@ -181,6 +192,45 @@
(line-widths (slice widths start end)))
(position-line line-words line-widths space-width x0 y))))
line-ranges)))
(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
pretext-layout-lines
(fn
(words widths ranges space-width max-width line-height)
(let
((n-lines (len ranges)))
(map
(fn
(line-idx)
(let
((range (nth ranges line-idx))
(y (* line-idx line-height)))
(let
((start (first range)) (end (nth range 1)))
(let
((lw (slice words start end))
(lwid (slice widths start end)))
(let
((total-w (reduce + 0 lwid))
(n-gaps (max 1 (- (len lw) 1)))
(is-last (= line-idx (- n-lines 1))))
(let
((gap (if is-last space-width (/ (- max-width total-w) n-gaps))))
{:y y :words (pretext-position-line lw lwid gap)}))))))
(range n-lines)))))
(define
make-hyphenation-trie
(fn
@@ -327,31 +377,4 @@
(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))

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -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-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
({"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-653fa705",[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

View File

@@ -1,4 +1,5 @@
;; Pretext island — client-side text layout with live controls
;; Uses bytecode-compiled break-lines from text-layout library.
(defisland
~pretext-demo/live
@@ -13,51 +14,9 @@
(canvas (host-call doc "createElement" "canvas"))
(ctx (host-call canvas "getContext" "2d")))
(let
((mw (fn (word sz) (do (host-set! ctx "font" (str sz "px 'Pretext Serif', DejaVu Serif, serif")) (host-get (host-call ctx "measureText" word) "width"))))
(sw-fn
(fn
(widths sw from to)
(let
loop
((k from) (total 0))
(if
(>= k to)
(+ total (* (max 0 (- (- to from) 1)) sw))
(loop (+ k 1) (+ total (nth widths k)))))))
(brk-greedy
(fn
(widths sw mx)
(let
((n (len widths)) (lines (list)) (st 0) (us 0))
(for-each
(fn
(i)
(let
((w (nth widths i)) (nd (if (= i st) w (+ us sw w))))
(if
(and (> nd mx) (not (= i st)))
(do
(set! lines (append lines (list (list st i))))
(set! st i)
(set! us w))
(set! us nd))))
(range n))
(append lines (list (list st n))))))
(pos-line
(fn
(lw lwid gap)
(let
loop
((i 0) (x 0) (acc (list)))
(if
(>= i (len lw))
acc
(loop
(+ i 1)
(+ x (nth lwid i) gap)
(append acc (list {:x x :word (nth lw i)}))))))))
((mw (fn (word sz) (do (host-set! ctx "font" (str sz "px 'Pretext Serif', DejaVu Serif, serif")) (host-get (host-call ctx "measureText" word) "width")))))
(let
((layout (computed (fn () (let ((sz (deref font-size)) (mxw (deref max-w)) (opt (deref use-optimal))) (let ((widths (map (fn (w) (mw w sz)) words)) (spw (mw " " sz)) (lh (* sz 1.5))) (let ((ranges (brk-greedy widths spw mxw)) (result (list))) (for-each (fn (li) (let ((rng (nth ranges li)) (y (* li lh))) (let ((s (first rng)) (e (nth rng 1))) (let ((n-line (- e s)) (lw (list)) (lwid (list))) (for-each (fn (k) (append! lw (nth words (+ s k))) (append! lwid (nth widths (+ s k)))) (range n-line)) (let ((tw (reduce + 0 lwid)) (ng (max 1 (- n-line 1))) (il (= li (- (len ranges) 1)))) (let ((gap (if il spw (/ (- mxw tw) ng)))) (append! result {:y y :words (pos-line lw lwid gap)}))))))) (range (len ranges))) result)))))))
((layout (computed (fn () (let ((sz (deref font-size)) (mxw (deref max-w)) (opt (deref use-optimal))) (let ((widths (map (fn (w) (mw w sz)) words)) (spw (mw " " sz)) (lh (* sz 1.5))) (let ((ranges (if opt (break-lines widths spw mxw) (break-lines-greedy widths spw mxw)))) (pretext-layout-lines words widths ranges spw mxw lh))))))))
(div
(~tw :tokens "space-y-4")
(div