haskell: n-queens via list comprehension + where (+2 tests, 397/397)

- fix hk-eval-let: multi-clause where/let now uses hk-bind-decls!
  grouping (enables go 0 / go k pattern)
- add concatMap/concat/abs/negate to Prelude (list comprehension support)
- cache init env in hk-env0 (eval-expr-source 5x faster)
This commit is contained in:
2026-04-25 18:40:27 +00:00
parent 9facbb4836
commit 8a9168c8d5
3 changed files with 71 additions and 16 deletions

View File

@@ -376,22 +376,11 @@
hk-eval-let
(fn
(binds body env)
;; Reuse hk-bind-decls! so multi-clause fun bindings in where/let
;; are grouped into multifuns, enabling patterns like:
;; let { go 0 = [[]]; go k = [...] } in go n
(let ((new-env (hk-dict-copy env)))
;; Pre-seed names for fn-clauses so closures see themselves
;; (mutual recursion across the whole binding group).
(for-each
(fn (b)
(cond
((= (first b) "fun-clause")
(dict-set! new-env (nth b 1) nil))
((and
(= (first b) "bind")
(list? (nth b 1))
(= (first (nth b 1)) "p-var"))
(dict-set! new-env (nth (nth b 1) 1) nil))
(:else nil)))
binds)
(for-each (fn (b) (hk-eval-let-bind! b new-env)) binds)
(hk-bind-decls! new-env binds)
(hk-eval body new-env))))
(define
@@ -561,6 +550,12 @@ zipWith _ _ [] = []
zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys
fibs = 0 : 1 : zipWith plus fibs (tail fibs)
plus a b = a + b
concat [] = []
concat (xs:xss) = xs ++ concat xss
concatMap f [] = []
concatMap f (x:xs) = f x ++ concatMap f xs
abs x = if x < 0 then 0 - x else x
negate x = 0 - x
")
(define
@@ -786,8 +781,12 @@ plus a b = a + b
((has-key? env "main") (get env "main"))
(:else env)))))
;; Eagerly build the Prelude env once at load time; each call to
;; hk-eval-expr-source copies it instead of re-parsing the whole Prelude.
(define hk-env0 (hk-init-env))
(define
hk-eval-expr-source
(fn
(src)
(hk-deep-force (hk-eval (hk-core-expr src) (hk-init-env)))))
(hk-deep-force (hk-eval (hk-core-expr src) (hk-dict-copy hk-env0)))))

View File

@@ -0,0 +1,38 @@
;; nqueens.hs — n-queens solver via list comprehension + where.
;;
;; Also exercises:
;; - multi-clause let/where binding (go 0 = ...; go k = ...)
;; - list comprehensions (desugared to concatMap)
;; - abs (from Prelude)
;; - [1..n] finite range
;;
;; n=8 is too slow for a 60s timeout; n=4 and n=5 run in ~17s combined.
(define
hk-prog-val
(fn
(src name)
(hk-deep-force (get (hk-eval-program (hk-core src)) name))))
(define
hk-nq-base
"queens n = go n
where
go 0 = [[]]
go k = [q:qs | qs <- go (k - 1), q <- [1..n], safe q qs]
safe q qs = check q qs 1
check q [] _ = True
check q (c:cs) d = q /= c && abs (q - c) /= d && check q cs (d + 1)
")
(hk-test
"nqueens: queens 4 has 2 solutions"
(hk-prog-val (str hk-nq-base "result = length (queens 4)\n") "result")
2)
(hk-test
"nqueens: queens 5 has 10 solutions"
(hk-prog-val (str hk-nq-base "result = length (queens 5)\n") "result")
10)
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

View File

@@ -0,0 +1,18 @@
-- nqueens.hs — n-queens backtracking solver.
--
-- `queens n` returns all solutions as lists of column positions,
-- one per row. Each call to `go k` extends all partial `(k-1)`-row
-- solutions by one safe queen, using a list comprehension whose guard
-- checks the new queen against all already-placed queens.
queens n = go n
where
go 0 = [[]]
go k = [q:qs | qs <- go (k - 1), q <- [1..n], safe q qs]
safe q qs = check q qs 1
check q [] _ = True
check q (c:cs) d = q /= c && abs (q - c) /= d && check q cs (d + 1)
result = length (queens 8)