ocaml: phase 5 parse ctor arg types in user type-defs (+3 tests, 409 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
ocaml-hm-parse-type-src recognises primitive type names (int/bool/ string/float/unit), tyvars 'a, and simple parametric T list / T option. Replaces the previous int-by-default placeholder in ocaml-hm-register-type-def!. So 'type tag = TStr of string | TInt of int' correctly registers TStr : string -> tag and TInt : int -> tag. Pattern-match on tag gives proper field types in the body. Multi-arg / function types still fall back to a fresh tv.
This commit is contained in:
@@ -412,11 +412,35 @@
|
|||||||
(set-nth! ocaml-hm-ctors 0
|
(set-nth! ocaml-hm-ctors 0
|
||||||
(merge (nth ocaml-hm-ctors 0) (dict name scheme)))))
|
(merge (nth ocaml-hm-ctors 0) (dict name scheme)))))
|
||||||
|
|
||||||
;; Process a :type-def AST. For each ctor, build its scheme:
|
;; Parse a simple type source into an HM type. Handles primitive type
|
||||||
;; nullary `A` → scheme [] (con NAME [param-tvs...])
|
;; names, type variables `'a`, parametric `'a list`, `T1 * T2`, and
|
||||||
;; ctor `B of int` → scheme [] (int -> (con NAME [...]))
|
;; function `T1 -> T2`. Unknown tokens default to a fresh tv so the
|
||||||
;; Argument types are ignored for now (they're raw source strings) — we
|
;; result is at worst polymorphic, never wrong.
|
||||||
;; assume `int`. A future iteration parses arg types properly.
|
(define ocaml-hm-parse-type-src
|
||||||
|
(fn (src)
|
||||||
|
(let ((s (trim src)))
|
||||||
|
(cond
|
||||||
|
((= s "int") (hm-int))
|
||||||
|
((= s "bool") (hm-bool))
|
||||||
|
((= s "string") (hm-string))
|
||||||
|
((= s "float") (ocaml-hm-float))
|
||||||
|
((= s "unit") (hm-con "Unit" (list)))
|
||||||
|
((and (> (len s) 1) (= (nth s 0) "'"))
|
||||||
|
(hm-tv (slice s 1 (len s))))
|
||||||
|
;; "T list" / "T option" — split on space, treat last as ctor.
|
||||||
|
(else
|
||||||
|
(let ((parts (filter (fn (p) (not (= p ""))) (split s " "))))
|
||||||
|
(cond
|
||||||
|
((= (len parts) 2)
|
||||||
|
(let ((arg (ocaml-hm-parse-type-src (first parts)))
|
||||||
|
(head (nth parts 1)))
|
||||||
|
(hm-con head (list arg))))
|
||||||
|
(else
|
||||||
|
;; Unknown: emit a fresh tv so unification stays sound.
|
||||||
|
(hm-tv (str "_unknown"))))))))))
|
||||||
|
|
||||||
|
;; Process a :type-def AST. For each ctor, build its scheme. Multi-arg
|
||||||
|
;; ctors are a list of types — we model that as a tuple arg.
|
||||||
(define ocaml-hm-register-type-def!
|
(define ocaml-hm-register-type-def!
|
||||||
(fn (type-def)
|
(fn (type-def)
|
||||||
(let ((name (nth type-def 1))
|
(let ((name (nth type-def 1))
|
||||||
@@ -434,11 +458,12 @@
|
|||||||
(ocaml-hm-ctor-register! cname
|
(ocaml-hm-ctor-register! cname
|
||||||
(hm-scheme params self-type)))
|
(hm-scheme params self-type)))
|
||||||
(else
|
(else
|
||||||
;; Single-arg ctor with arg type `int` (placeholder).
|
;; ARG-SRCS is a list of source strings, often a
|
||||||
;; Multi-arg or other-typed ctors fall back to int.
|
;; single combined string `T1 * T2 * ...`. Parse.
|
||||||
(ocaml-hm-ctor-register! cname
|
(let ((arg-type (ocaml-hm-parse-type-src (first arg-srcs))))
|
||||||
(hm-scheme params
|
(ocaml-hm-ctor-register! cname
|
||||||
(hm-arrow (hm-int) self-type))))))))
|
(hm-scheme params
|
||||||
|
(hm-arrow arg-type self-type)))))))))
|
||||||
(for-each register-ctor ctors)))))))
|
(for-each register-ctor ctors)))))))
|
||||||
|
|
||||||
(set! ocaml-infer
|
(set! ocaml-infer
|
||||||
|
|||||||
@@ -1004,6 +1004,14 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(epoch 3005)
|
(epoch 3005)
|
||||||
(eval "(ocaml-run \"String.index_of \\\"hello\\\" \\\"ll\\\"\")")
|
(eval "(ocaml-run \"String.index_of \\\"hello\\\" \\\"ll\\\"\")")
|
||||||
|
|
||||||
|
;; ── HM with parsed ctor arg types ──────────────────────────────
|
||||||
|
(epoch 3100)
|
||||||
|
(eval "(ocaml-type-of-program \"type shape = Circle of int | Square of int;; let area s = match s with | Circle r -> r * r | Square s -> s * s;; area\")")
|
||||||
|
(epoch 3101)
|
||||||
|
(eval "(ocaml-type-of-program \"type tag = TStr of string | TInt of int;; TStr \\\"hi\\\"\")")
|
||||||
|
(epoch 3102)
|
||||||
|
(eval "(ocaml-type-of-program \"type t = A of bool | B of float;; A true\")")
|
||||||
|
|
||||||
EPOCHS
|
EPOCHS
|
||||||
|
|
||||||
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||||
@@ -1588,6 +1596,11 @@ check 3003 "String.split_on_char" '("a" "b" "c")'
|
|||||||
check 3004 "String.replace_all" '"herro"'
|
check 3004 "String.replace_all" '"herro"'
|
||||||
check 3005 "String.index_of" '2'
|
check 3005 "String.index_of" '2'
|
||||||
|
|
||||||
|
# ── HM with parsed ctor arg types ──────────────────────────────
|
||||||
|
check 3100 "shape -> Int" '"shape -> Int"'
|
||||||
|
check 3101 "TStr 'hi' : tag" '"tag"'
|
||||||
|
check 3102 "A true : t" '"t"'
|
||||||
|
|
||||||
TOTAL=$((PASS + FAIL))
|
TOTAL=$((PASS + FAIL))
|
||||||
if [ $FAIL -eq 0 ]; then
|
if [ $FAIL -eq 0 ]; then
|
||||||
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
||||||
|
|||||||
@@ -236,8 +236,10 @@ SX CEK evaluator (both JS and OCaml hosts)
|
|||||||
`ocaml-hm-register-type-def!` registers user types from `:type-def`.
|
`ocaml-hm-register-type-def!` registers user types from `:type-def`.
|
||||||
`ocaml-type-of-program` threads decls through the env, registering
|
`ocaml-type-of-program` threads decls through the env, registering
|
||||||
types and binding `let` schemes. `:con NAME` / `:pcon NAME …`
|
types and binding `let` schemes. `:con NAME` / `:pcon NAME …`
|
||||||
instantiate from the registry. _(Caveat: ctor arg types currently
|
instantiate from the registry. Ctor arg types parsed via
|
||||||
default to `int` — proper type parsing pending.)_
|
`ocaml-hm-parse-type-src` — handles primitives (`int`/`bool`/
|
||||||
|
`string`/`float`/`unit`), tyvars `'a`, simple parametric `T list`/
|
||||||
|
`T option`. Multi-arg/complex types fall back to a fresh tv.
|
||||||
- [~] Function types `T1 -> T2` work; tuples (`'a * 'b`) and lists
|
- [~] Function types `T1 -> T2` work; tuples (`'a * 'b`) and lists
|
||||||
(`'a list`) supported. Records pending.
|
(`'a list`) supported. Records pending.
|
||||||
- [ ] Type signatures: `val f : int -> int` — verify against inferred type.
|
- [ ] Type signatures: `val f : int -> int` — verify against inferred type.
|
||||||
@@ -377,6 +379,12 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- 2026-05-08 Phase 5 — parse simple type sources in user type-defs
|
||||||
|
(+3 tests, 409 total). `ocaml-hm-parse-type-src` recognises
|
||||||
|
primitive type names, tyvars `'a`, and `T list`/`T option`-style
|
||||||
|
parametric types. Replaces the old "default to Int" placeholder so
|
||||||
|
`type t = TStr of string` correctly registers `TStr : string -> t`.
|
||||||
|
Multi-arg / function types still fall back to a fresh tv.
|
||||||
- 2026-05-08 Phase 6 — String extensions: ends_with/contains/trim/
|
- 2026-05-08 Phase 6 — String extensions: ends_with/contains/trim/
|
||||||
split_on_char/replace_all/index_of (+6 tests, 406 total). Wraps host
|
split_on_char/replace_all/index_of (+6 tests, 406 total). Wraps host
|
||||||
primitives via `_string_*` builtins.
|
primitives via `_string_*` builtins.
|
||||||
|
|||||||
Reference in New Issue
Block a user