coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

haskell: Phase 13 — class default method registration + dispatch fallback
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s
Details

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-07 12:39:46 +00:00
parent c821e21f94
commit 5a8c25bec7
2 changed files with 71 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
lib/haskell/eval.sx
View File

@@ -1258,15 +1258,66 @@
((key (str "dict" cls "_" (hk-runtime-type tv)))) ((key (str "dict" cls "_" (hk-runtime-type tv))))
(if (if
(has-key? env key) (has-key? env key)
(hk-apply (get (get env key) mname) x) (let
(raise ((inst (get env key)))
(str (if
"No instance " (has-key? inst mname)
cls (hk-apply (get inst mname) x)
" for " (if
(hk-runtime-type tv))))))) (has-key?
env
(str "__default__" cls "_" mname))
(hk-apply
(get
env
(str
"__default__"
cls
"_"
mname))
x)
(raise
(str
"No method "
mname
" in instance "
cls
" for "
(hk-runtime-type tv))))))
(if
(has-key?
env
(str "__default__" cls "_" mname))
(hk-apply
(get
env
(str "__default__" cls "_" mname))
x)
(raise
(str
"No instance "
cls
" for "
(hk-runtime-type tv))))))))
1))) 1)))
(nth m 1)))) (nth m 1))))
method-decls)
(for-each
(fn
(m)
(when
(= (first m) "fun-clause")
(let
((mname (nth m 1))
(pats (nth m 2))
(body (nth m 3)))
(dict-set!
env
(str "__default__" cls "_" mname)
(if
(empty? pats)
(hk-eval body env)
(hk-eval (list "lambda" pats body) env))))))
method-decls))) method-decls)))
((= (first d) "instance-decl") ((= (first d) "instance-decl")
(let (let
@@ -1363,12 +1414,7 @@
(let (let
((modname (nth d 2)) (as-name (nth d 3))) ((modname (nth d 2)) (as-name (nth d 3)))
(let (let
((alias ((alias (cond ((not (nil? as-name)) as-name) ((= modname "Data.Map") "Map") ((= modname "Data.Set") "Set") (:else modname))))
(cond
((not (nil? as-name)) as-name)
((= modname "Data.Map") "Map")
((= modname "Data.Set") "Set")
(:else modname))))
(cond (cond
((= modname "Data.Map") (hk-bind-data-map! env alias)) ((= modname "Data.Map") (hk-bind-data-map! env alias))
((= modname "Data.Set") (hk-bind-data-set! env alias)) ((= modname "Data.Set") (hk-bind-data-set! env alias))

14
plans/haskell-completeness.md
View File

@@ -223,10 +223,10 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
- [x] Verify `where`-clauses in `instance` bodies desugar correctly. The - [x] Verify `where`-clauses in `instance` bodies desugar correctly. The
`hk-bind-decls!` instance arm must call the same where-lifting logic as `hk-bind-decls!` instance arm must call the same where-lifting logic as
top-level function clauses. Write a targeted test to confirm. top-level function clauses. Write a targeted test to confirm.
- [ ] Class declarations may include default method implementations. Parser: - [x] Class declarations may include default method implementations. Parser:
`hk-parse-class` collects method decls; eval registers defaults under `hk-parse-class` collects method decls; eval registers defaults under
`"__default__ClassName_method"` in the class dict. `"__default__ClassName_method"` in the class dict.
- [ ] Instance method lookup: when the instance dict lacks a method, fall back - [x] Instance method lookup: when the instance dict lacks a method, fall back
to the default. Wire this into the dictionary-passing dispatch. to the default. Wire this into the dictionary-passing dispatch.
- [ ] `Eq` default: `(/=) x y = not (x == y)`. Verify it works without an - [ ] `Eq` default: `(/=) x y = not (x == y)`. Verify it works without an
explicit `/=` in every Eq instance. explicit `/=` in every Eq instance.
@@ -307,6 +307,16 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
_Newest first._ _Newest first._
**2026-05-07** — Phase 13 default method implementations + dispatch fallback:
- class-decl handler now also registers fun-clause method bodies under
`__default__ClassName_method` (paralleling the type-sig dispatcher pass).
- Dispatcher rewritten as nested `if`s: instance dict has the method →
use it; else look up default → use it; else raise. Earlier attempt with
`cond + and` infinite-looped — switched to plain `if` form which works.
- Both regular dispatch (`describe x = "a boolean"` instance) and default
fallback (`hello x = "hi"` default with empty instance body) verified.
No regressions in class/deriving/instance-where/eval suites.
**2026-05-07** — Phase 13 `where`-clauses in `instance` bodies: **2026-05-07** — Phase 13 `where`-clauses in `instance` bodies:
- Bug discovered: `hk-desugar` didn't recurse into `instance-decl` method - Bug discovered: `hk-desugar` didn't recurse into `instance-decl` method
bodies, so a `where`-form in an instance method survived to eval and hit bodies, so a `where`-form in an instance method survived to eval and hit