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))))
(if
(has-key? env key)
(hk-apply (get (get env key) mname) x)
(raise
(str
"No instance "
cls
" for "
(hk-runtime-type tv)))))))
(let
((inst (get env key)))
(if
(has-key? inst mname)
(hk-apply (get inst mname) x)
(if
(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)))
(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)))
((= (first d) "instance-decl")
(let
@@ -1363,12 +1414,7 @@
(let
((modname (nth d 2)) (as-name (nth d 3)))
(let
((alias
(cond
((not (nil? as-name)) as-name)
((= modname "Data.Map") "Map")
((= modname "Data.Set") "Set")
(:else modname))))
((alias (cond ((not (nil? as-name)) as-name) ((= modname "Data.Map") "Map") ((= modname "Data.Set") "Set") (:else modname))))
(cond
((= modname "Data.Map") (hk-bind-data-map! env alias))
((= modname "Data.Set") (hk-bind-data-set! env alias))