diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index 2322f994..46eb364b 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -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))))) diff --git a/lib/haskell/tests/program-nqueens.sx b/lib/haskell/tests/program-nqueens.sx new file mode 100644 index 00000000..6b1ea587 --- /dev/null +++ b/lib/haskell/tests/program-nqueens.sx @@ -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} diff --git a/lib/haskell/tests/programs/nqueens.hs b/lib/haskell/tests/programs/nqueens.hs new file mode 100644 index 00000000..3246858e --- /dev/null +++ b/lib/haskell/tests/programs/nqueens.hs @@ -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)