HigherOrderCO / HVM

A massively parallel, optimal functional runtime in Rust

Home Page:https://higherorderco.com

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

[Regression] Incorrect result on `nqueens` program

vpclmulqdq opened this issue · comments

The following implementation of nqueens puzzle

(If 1 t e) = t
(If 0 t e) = e

(Len Nil         r) = r
(Len (Cons _ xs) r) = (Len xs (+ r 1))

(IsSafe x d         Nil) = 1
(IsSafe x d (Cons q qs)) = (& (!= x q) (& (!= x (+ q d)) (& (!= x (- q d)) (IsSafe x (+ d 1) qs))))

(Gen n 0) = (Cons Nil Nil)
(Gen n k) = (Gen.Outer n (Gen n (- k 1)) Nil)

(Gen.Outer n Nil         r) = r
(Gen.Outer n (Cons b bs) r) = (Gen.Inner n b bs 1 r)

(Gen.Inner n b bs q r) =
  (If (> q n)
    (Gen.Outer n bs r)
    (Gen.Inner n b bs (+ q 1)
      (If (IsSafe q 1 b)
        (Cons (Cons q b) r)
        r)))

(Main n) = (Len (Gen n n) 0)

outputs incorrect result on HEAD. I've bisect'ed it to e449824; previous commit, e47eb43, used to execute the program correctly.

Outputs, in both interpreted and compiled1 mode:

n e449824, HEAD e47eb43, GHC
1 1 1
2 0 0
3 0 0
4 2 2
5 4 10
6 0 4
7 2 40
8 10 92
haskell translation
import System.Environment
import Data.Word

data List a = Nil | Cons a (List a)

len :: List a -> Word64 -> Word64
len Nil         r = r
len (Cons _ xs) r = len xs (r + 1)

isSafe :: Word64 -> Word64 -> List Word64 -> Bool
isSafe x d         Nil = True
isSafe x d (Cons q qs) = x /= q && x /= (q + d) && x /= (q - d) && isSafe x (d + 1) qs

gen :: Word64 -> Word64 -> List (List Word64)
gen n 0 = Cons Nil Nil
gen n k = genOuter n (gen n (k - 1)) Nil

genOuter :: Word64 -> List (List Word64) -> List (List Word64) -> List (List Word64)
genOuter n Nil         r = r
genOuter n (Cons b bs) r = genInner n b bs 1 r

genInner :: Word64 -> List Word64 -> List (List Word64) -> Word64 -> List (List Word64) -> List (List Word64)
genInner n b bs q r = if q > n then genOuter n bs r else genInner n b bs (q + 1) (if isSafe q 1 b then Cons (Cons q b) r else r)

main :: IO ()
main = do
  n <- read . head <$> getArgs
  print $ len (gen n n) 0

Footnotes

  1. It seems to me that neither e47eb43 nor e449824 supported passing arguments to Main in compiled mode (I was getting <arg> as output when I tried), so for that tests I've replaced n with desired constant in Main manually.

Thanks for the bug report. Do you have an equivalent Haskell implementation so I can compare and debug?

Regarding the compiled args issue, how are you running it? This works for me:

hvm compile queens.hvm
cd queens
cargo build --release
./target/release/queens run "(Main 5)"

Are you on hvm-1.0.0-beta? (hvm --version)

Are you on hvm-1.0.0-beta? (hvm --version)

Oh, I'm sorry, I wasn't clear enough. The issue was only with version 0.1.88, specifically commits e47eb43 and e449824. Everything works fine on HEAD.

The point of that note was only to make it clear that when testing older versions of HVM in compiled mode I wasn't running the program as posted, but a slight modification of it.

Do you have an equivalent Haskell implementation so I can compare and debug?

It is hidden under a details tag right after the table in the original post, but here is it again, just in case:

import System.Environment
import Data.Word

data List a = Nil | Cons a (List a)

len :: List a -> Word64 -> Word64
len Nil         r = r
len (Cons _ xs) r = len xs (r + 1)

isSafe :: Word64 -> Word64 -> List Word64 -> Bool
isSafe x d         Nil = True
isSafe x d (Cons q qs) = x /= q && x /= (q + d) && x /= (q - d) && isSafe x (d + 1) qs

gen :: Word64 -> Word64 -> List (List Word64)
gen n 0 = Cons Nil Nil
gen n k = genOuter n (gen n (k - 1)) Nil

genOuter :: Word64 -> List (List Word64) -> List (List Word64) -> List (List Word64)
genOuter n Nil         r = r
genOuter n (Cons b bs) r = genInner n b bs 1 r

genInner :: Word64 -> List Word64 -> List (List Word64) -> Word64 -> List (List Word64) -> List (List Word64)
genInner n b bs q r = if q > n then genOuter n bs r else genInner n b bs (q + 1) (if isSafe q 1 b then Cons (Cons q b) r else r)

main :: IO ()
main = do
  n <- read . head <$> getArgs
  print $ len (gen n n) 0

Sorry, I was in a hurry and missed that info. The bug is fixed on master. Note that to get most of HVM, you really should try to linearize your programs as much as possible, so you should avoid If and linearize genInner, as in:

(Gen.Inner n b bs q r) = (Gen.Inner.aux (> q n) (IsSafe q 1 b) n b bs q r)
  (Gen.Inner.aux 1 _ n b bs q r) = (Gen.Outer n bs r)
  (Gen.Inner.aux 0 1 n b bs q r) = (Gen.Inner n b bs (+ q 1) (Cons (Cons q b) r))
  (Gen.Inner.aux 0 0 n b bs q r) = (Gen.Inner n b bs (+ q 1) r)

Also this algorithm seems pretty sequential and lower-order, so I don't think HVM will do a great job at it, sadly. I'd need to understand what it is going to give advice on how to write the recursion in a more parallel way.