Recompile all 26 .sxbc with define-library wrappers + fix eval/JIT
All 26 browser modules recompiled with define-library/import forms. Compilation works without vm-compile-adapter (JIT pre-compilation hangs with library wrappers in some JIT paths — skipped for now, CEK compilation is ~34s total). Key fixes: - eval command: import-aware loop that handles define-library/import locally without touching the Python bridge pipe (avoids deadlock) - compile-modules.js: skip vm-compile-adapter, bump timeout 2621/2621 OCaml tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1446,6 +1446,8 @@
|
||||
("perform" (step-sf-perform args env kont))
|
||||
("define-library" (step-sf-define-library args env kont))
|
||||
("import" (step-sf-import args env kont))
|
||||
("define-record-type"
|
||||
(make-cek-value (sf-define-record-type args env) env kont))
|
||||
(_
|
||||
(cond
|
||||
(has-key? *custom-special-forms* name)
|
||||
@@ -1573,6 +1575,64 @@
|
||||
env
|
||||
(kont-push (make-perform-frame env) kont)))))
|
||||
|
||||
;; R7RS records (SRFI-9)
|
||||
;;
|
||||
;; (define-record-type <point>
|
||||
;; (make-point x y)
|
||||
;; point?
|
||||
;; (x point-x)
|
||||
;; (y point-y set-point-y!))
|
||||
;;
|
||||
;; Creates: constructor, predicate, accessors, optional mutators.
|
||||
;; Opaque — only accessible through generated functions.
|
||||
;; Generative — each call creates a unique type.
|
||||
(define
|
||||
sf-define-record-type
|
||||
(fn
|
||||
(args env)
|
||||
(let
|
||||
((type-sym (first args))
|
||||
(ctor-spec (nth args 1))
|
||||
(pred-sym (nth args 2))
|
||||
(field-specs (slice args 3)))
|
||||
(let
|
||||
((raw-name (symbol-name type-sym)))
|
||||
(let
|
||||
((type-name
|
||||
(if
|
||||
(and (starts-with? raw-name "<") (ends-with? raw-name ">"))
|
||||
(slice raw-name 1 (- (len raw-name) 1))
|
||||
raw-name))
|
||||
(ctor-name (symbol-name (first ctor-spec)))
|
||||
(ctor-params (map (fn (s) (symbol-name s)) (rest ctor-spec)))
|
||||
(pred-name (symbol-name pred-sym))
|
||||
(field-names
|
||||
(map (fn (fs) (symbol-name (first fs))) field-specs)))
|
||||
(let
|
||||
((rtd-uid (make-rtd type-name field-names ctor-params)))
|
||||
;; Constructor — OCaml returns a NativeFn
|
||||
(env-bind! env ctor-name
|
||||
(make-record-constructor rtd-uid))
|
||||
;; Predicate — OCaml returns a NativeFn
|
||||
(env-bind! env pred-name
|
||||
(make-record-predicate rtd-uid))
|
||||
;; Accessors and optional mutators
|
||||
(for-each-indexed
|
||||
(fn
|
||||
(idx fs)
|
||||
(let
|
||||
((accessor-name (symbol-name (nth fs 1))))
|
||||
(env-bind! env accessor-name
|
||||
(make-record-accessor idx))
|
||||
(when
|
||||
(>= (len fs) 3)
|
||||
(let
|
||||
((mutator-name (symbol-name (nth fs 2))))
|
||||
(env-bind! env mutator-name
|
||||
(make-record-mutator idx))))))
|
||||
field-specs)
|
||||
nil))))))
|
||||
|
||||
;; Delimited continuations
|
||||
(define
|
||||
step-sf-callcc
|
||||
|
||||
185
spec/tests/test-records.sx
Normal file
185
spec/tests/test-records.sx
Normal file
@@ -0,0 +1,185 @@
|
||||
;; R7RS define-record-type tests (SRFI-9)
|
||||
|
||||
(defsuite
|
||||
"record-basic"
|
||||
(deftest
|
||||
"constructor and predicate"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(let
|
||||
((p (make-point 3 4)))
|
||||
(assert (point? p))
|
||||
(assert= 3 (point-x p))
|
||||
(assert= 4 (point-y p)))))
|
||||
(deftest
|
||||
"predicate rejects non-records"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(assert= false (point? 42))
|
||||
(assert= false (point? "hello"))
|
||||
(assert= false (point? (list 1 2)))
|
||||
(assert= false (point? {:x 1 :y 2}))))
|
||||
(deftest
|
||||
"type-of returns stripped name"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(assert= "point" (type-of (make-point 1 2)))))
|
||||
(deftest
|
||||
"record is not a dict"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(assert= false (dict? (make-point 1 2)))
|
||||
(assert= false (list? (make-point 1 2)))
|
||||
(assert (record? (make-point 1 2))))))
|
||||
|
||||
(defsuite
|
||||
"record-mutator"
|
||||
(deftest
|
||||
"set! via mutator"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y set-point-y!))
|
||||
(let
|
||||
((p (make-point 3 4)))
|
||||
(set-point-y! p 99)
|
||||
(assert= 99 (point-y p))
|
||||
(assert= 3 (point-x p)))))
|
||||
(deftest
|
||||
"multiple mutations"
|
||||
(do
|
||||
(define-record-type <cell>
|
||||
(make-cell value)
|
||||
cell?
|
||||
(value cell-value set-cell-value!))
|
||||
(let
|
||||
((c (make-cell 0)))
|
||||
(set-cell-value! c 1)
|
||||
(set-cell-value! c 2)
|
||||
(set-cell-value! c 3)
|
||||
(assert= 3 (cell-value c))))))
|
||||
|
||||
(defsuite
|
||||
"record-generative"
|
||||
(deftest
|
||||
"distinct types with same fields"
|
||||
(do
|
||||
(define-record-type <a>
|
||||
(make-a v)
|
||||
a?
|
||||
(v a-v))
|
||||
(define-record-type <b>
|
||||
(make-b v)
|
||||
b?
|
||||
(v b-v))
|
||||
(let
|
||||
((x (make-a 1))
|
||||
(y (make-b 2)))
|
||||
(assert (a? x))
|
||||
(assert= false (a? y))
|
||||
(assert= false (b? x))
|
||||
(assert (b? y)))))
|
||||
(deftest
|
||||
"record? matches any record"
|
||||
(do
|
||||
(define-record-type <a>
|
||||
(make-a v)
|
||||
a?
|
||||
(v a-v))
|
||||
(define-record-type <b>
|
||||
(make-b v)
|
||||
b?
|
||||
(v b-v))
|
||||
(assert (record? (make-a 1)))
|
||||
(assert (record? (make-b 2)))
|
||||
(assert= false (record? 42)))))
|
||||
|
||||
(defsuite
|
||||
"record-field-reorder"
|
||||
(deftest
|
||||
"constructor params in different order"
|
||||
(do
|
||||
(define-record-type <pair>
|
||||
(make-pair second first)
|
||||
pair?
|
||||
(first pair-first)
|
||||
(second pair-second))
|
||||
(let
|
||||
((p (make-pair 2 1)))
|
||||
(assert= 1 (pair-first p))
|
||||
(assert= 2 (pair-second p)))))
|
||||
(deftest
|
||||
"three fields reordered"
|
||||
(do
|
||||
(define-record-type <triple>
|
||||
(make-triple c a b)
|
||||
triple?
|
||||
(a triple-a)
|
||||
(b triple-b)
|
||||
(c triple-c))
|
||||
(let
|
||||
((t (make-triple 30 10 20)))
|
||||
(assert= 10 (triple-a t))
|
||||
(assert= 20 (triple-b t))
|
||||
(assert= 30 (triple-c t))))))
|
||||
|
||||
(defsuite
|
||||
"record-nested"
|
||||
(deftest
|
||||
"records containing records"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(define-record-type <line>
|
||||
(make-line start end)
|
||||
line?
|
||||
(start line-start)
|
||||
(end line-end))
|
||||
(let
|
||||
((l (make-line (make-point 0 0) (make-point 3 4))))
|
||||
(assert (line? l))
|
||||
(assert (point? (line-start l)))
|
||||
(assert= 0 (point-x (line-start l)))
|
||||
(assert= 4 (point-y (line-end l)))))))
|
||||
|
||||
(defsuite
|
||||
"record-equality"
|
||||
(deftest
|
||||
"equal records are equal"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(assert= (make-point 1 2) (make-point 1 2))))
|
||||
(deftest
|
||||
"different values are not equal"
|
||||
(do
|
||||
(define-record-type <point>
|
||||
(make-point x y)
|
||||
point?
|
||||
(x point-x)
|
||||
(y point-y))
|
||||
(assert (not (equal? (make-point 1 2) (make-point 1 3)))))))
|
||||
Reference in New Issue
Block a user