summaryrefslogtreecommitdiff
path: root/hsolve
diff options
context:
space:
mode:
Diffstat (limited to 'hsolve')
-rw-r--r--hsolve/.gitignore7
-rw-r--r--hsolve/FSu.hs152
-rw-r--r--hsolve/Main.hs427
-rw-r--r--hsolve/hsolve.cabal16
-rw-r--r--hsolve/stack.yaml65
5 files changed, 667 insertions, 0 deletions
diff --git a/hsolve/.gitignore b/hsolve/.gitignore
new file mode 100644
index 0000000..fc6561a
--- /dev/null
+++ b/hsolve/.gitignore
@@ -0,0 +1,7 @@
+*.hi
+*.o
+.stack-work/
+.cabal-sandbox
+cabal.sandbox.config
+.DS_Store
+*.swp \ No newline at end of file
diff --git a/hsolve/FSu.hs b/hsolve/FSu.hs
new file mode 100644
index 0000000..1bd250a
--- /dev/null
+++ b/hsolve/FSu.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE BangPatterns, ScopedTypeVariables, RankNTypes #-}
+module FSu(solve) where
+
+import Control.Monad
+import Control.Monad.ST
+import Data.Array.ST
+import Data.STRef
+
+
+type Value = Int -- Sudoku value
+type Index = Int -- Sudoku index
+
+type Arr s a = STArray s Int a
+
+data State s = State { stateMark :: Arr s Bool, stateResults :: STRef s [[Maybe Value]] }
+
+solve :: [Maybe Value] -> [[Maybe Value]]
+solve input = runST $ do
+ arr <- newListArray (0,80) $ map (maybe (-1) id) input :: ST s (Arr s Value)
+ mark <- newArray (0,8) False :: ST s (Arr s Bool)
+ results <- newSTRef [] :: ST s (STRef s [[Maybe Value]])
+ solveAt arr 0 (State mark results)
+ readSTRef results
+
+obtainResult :: Arr s Value -> ST s [Maybe Value]
+obtainResult arr = do
+ elems <- getElems arr
+ return $ [if v == (-1) then Nothing else Just v | v <- elems]
+
+solveAt :: Arr s Value -> Index -> State s -> ST s ()
+solveAt arr !i st = do
+ valid <- isValid arr st
+ when valid $ do
+ if i == 81
+ then do
+ res <- obtainResult arr
+ modifySTRef' (stateResults st) (res:)
+ else do
+ v <- readArray arr i
+ if v /= (-1)
+ then solveAt arr (i+1) st
+ else do
+ poss <- getPoss arr i st
+ tryAll arr i poss st
+
+tryAll :: Arr s Value -> Index -> [Value] -> State s -> ST s ()
+tryAll _ _ [] _ = return ()
+tryAll arr !i (v:vs) st = do
+ writeArray arr i v
+ solveAt arr (i+1) st
+ writeArray arr i (-1)
+ tryAll arr i vs st
+
+-- assumes the considered position is empty
+getPoss :: forall s. Arr s Value -> Index -> State s -> ST s [Value]
+getPoss arr i st = do
+ fillArray mark 0 8 True
+ goRow (rowOf i) 0
+ goCol (colOf i) 0
+ goBlock (blockOrigin (blockOf i)) 0
+ bs <- liftM (zip [0..8]) (getElems mark)
+ return $ map fst $ filter snd bs
+ where
+ mark = stateMark st
+
+ goRow :: Int -> Int -> ST s ()
+ goRow _ 9 = return ()
+ goRow r j = readArray arr (9 * r + j) >>= \v ->
+ when (v /= (-1)) (writeArray mark v False) >> goRow r (j+1)
+
+ goCol :: Int -> Int -> ST s ()
+ goCol _ 9 = return ()
+ goCol c j = readArray arr (9 * j + c) >>= \v ->
+ when (v /= (-1)) (writeArray mark v False) >> goCol c (j+1)
+
+ goBlock :: Int -> Int -> ST s ()
+ goBlock _ 9 = return ()
+ goBlock b j = readArray arr (b + 9 * (j `quot` 3) + j `rem` 3) >>= \v ->
+ when (v /= (-1)) (writeArray mark v False) >> goBlock b (j+1)
+
+isValid :: forall s. Arr s Value -> State s -> ST s Bool
+isValid arr st = do
+ goRows 0 >>= \r1 -> if r1
+ then goCols 0 >>= \r2 -> if r2
+ then goBlocks 0
+ else return False
+ else return False
+ where
+ goRows, goCols, goBlocks :: Int -> ST s Bool
+ goRows 9 = return True
+ goRows i = isValidRow arr i st >>= \r -> if r then goRows (i+1) else return False
+
+ goCols 9 = return True
+ goCols i = isValidCol arr i st >>= \r -> if r then goCols (i+1) else return False
+
+ goBlocks 9 = return True
+ goBlocks i = isValidBlock arr i st >>= \r -> if r then goBlocks (i+1) else return False
+
+isValidRow :: Arr s Value -> Index -> State s -> ST s Bool
+isValidRow arr r st = indexSetNoDups arr [9 * r + i | i <- [0..8]] st
+
+isValidCol :: Arr s Value -> Index -> State s -> ST s Bool
+isValidCol arr c st = indexSetNoDups arr [9 * i + c | i <- [0..8]] st
+
+isValidBlock :: Arr s Value -> Index -> State s -> ST s Bool
+isValidBlock arr b st = indexSetNoDups arr [blockOrigin b + 9 * y + x| y <- [0..2], x <- [0..2]] st
+
+indexSetNoDups :: forall s. Arr s Value -> [Index] -> State s -> ST s Bool
+indexSetNoDups arr set st = do
+ fillArray mark 0 8 False
+ applyInMark set
+ where
+ mark = stateMark st
+
+ applyInMark :: [Int] -> ST s Bool
+ applyInMark [] = return True
+ applyInMark (i:is) =
+ readArray arr i >>= \v ->
+ if v == (-1)
+ then applyInMark is
+ else do
+ b <- readArray mark v
+ if b
+ then return False
+ else writeArray mark v True >> applyInMark is
+
+fillArray :: Arr s a -> Int -> Int -> a -> ST s ()
+fillArray arr !i1 !i2 v
+ | i1 <= i2 = do
+ writeArray arr i1 v
+ fillArray arr (i1 + 1) i2 v
+ | otherwise = return ()
+
+rowOf :: Index -> Index
+rowOf i = i `quot` 9
+
+colOf :: Index -> Index
+colOf i = i `rem` 9
+
+blockOf :: Index -> Index
+blockOf i = 3 * (i `quot` 27) + (i `rem` 9) `quot` 3
+
+blockOrigin :: Index -> Index
+blockOrigin 0 = 0
+blockOrigin 1 = 3
+blockOrigin 2 = 6
+blockOrigin 3 = 27
+blockOrigin 4 = 30
+blockOrigin 5 = 33
+blockOrigin 6 = 54
+blockOrigin 7 = 57
+blockOrigin 8 = 60
diff --git a/hsolve/Main.hs b/hsolve/Main.hs
new file mode 100644
index 0000000..015cb0f
--- /dev/null
+++ b/hsolve/Main.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE RankNTypes #-}
+module Main where
+
+import Control.Monad
+import Control.Monad.Writer
+import Data.Char
+import Data.Either
+import Data.List
+import Data.Maybe
+import System.Exit
+
+import qualified FSu
+
+
+lupdate :: Int -> a -> [a] -> [a]
+lupdate 0 v (_:xs) = v:xs
+lupdate i v (x:xs) = x : lupdate (i-1) v xs
+lupdate _ _ [] = error "Empty list in lupdate"
+
+b2i :: Bool -> Int
+b2i = fromEnum
+
+
+newtype Sudoku = Sudoku [Either Value Poss] -- length 81
+ deriving (Show, Eq)
+
+type Value = Int
+
+newtype Poss = Poss [Bool] -- length 9
+ deriving (Show, Eq)
+
+
+at :: Sudoku -> Int -> Either Value Poss
+at (Sudoku l) i = l !! i
+
+atv :: Sudoku -> Int -> Maybe Value
+atv su i = case at su i of
+ Left v -> Just v
+ Right _ -> Nothing
+
+atp :: Sudoku -> Int -> Poss
+atp su i = case at su i of
+ Left _ -> Poss (replicate 9 False)
+ Right p -> p
+
+update :: Int -> Either Value Poss -> Sudoku -> Sudoku
+update i v (Sudoku l) = Sudoku $ lupdate i v l
+
+listPoss :: [Value] -> Poss
+listPoss l = Poss [i `elem` l | i <- [0..8]]
+
+possList :: Poss -> [Value]
+possList (Poss m) = map snd $ filter fst $ zip m [0..8]
+
+possAnd :: Poss -> Poss -> Poss
+possAnd (Poss l1) (Poss l2) = Poss (zipWith (&&) l1 l2)
+
+possOr :: Poss -> Poss -> Poss
+possOr (Poss l1) (Poss l2) = Poss (zipWith (||) l1 l2)
+
+possElem :: Value -> Poss -> Bool
+possElem n (Poss l) = 0 <= n && n < 9 && l !! n
+
+possExact1 :: [Poss] -> Poss
+possExact1 [] = Poss (replicate 9 False)
+possExact1 ps = Poss $ map (== 1) $ foldl1 (zipWith (+)) $ map (\(Poss p) -> map b2i p) ps
+
+possMakeAllExcept :: Value -> Poss
+possMakeAllExcept n = Poss $ map (\i -> if i == n then False else True) [0..8]
+
+possGetIfInOne :: [Poss] -> Value -> Maybe Int
+possGetIfInOne ps n = case concatMap (\(p,i) -> if n `possElem` p then [i] else []) (zip ps [0..]) of
+ [i] -> Just i
+ _ -> Nothing
+
+
+backtrackSolve :: Sudoku -> [Sudoku]
+backtrackSolve (Sudoku l) = do
+ let ml = map (either Just (const Nothing)) l
+ res <- FSu.solve ml
+ let l' = map (maybe (Right (listPoss [0..8])) Left) res
+ return $ Sudoku l'
+
+
+data Region = Row Int Sudoku | Col Int Sudoku | Block Int Sudoku | Cell Int Sudoku
+ deriving (Show, Eq)
+
+rowOf :: Region -> Region
+rowOf (Cell i su) = Row (i `div` 9) su
+
+colOf :: Region -> Region
+colOf (Cell i su) = Col (i `mod` 9) su
+
+blockOf :: Region -> Region
+blockOf (Cell i su) = Block (3 * (i `div` 27) + (i `mod` 9) `div` 3) su
+
+valueOf :: Region -> Maybe Value
+valueOf (Cell i su) = su `atv` i
+
+possOf :: Region -> Poss
+possOf (Cell i su) = su `atp` i
+
+contentsOf :: Region -> Either Value Poss
+contentsOf (Cell i su) = su `at` i
+
+indexOf :: Region -> Int
+indexOf (Cell i _) = i
+
+
+sudokuOf :: Region -> Sudoku
+sudokuOf (Cell _ su) = su
+sudokuOf (Row _ su) = su
+sudokuOf (Col _ su) = su
+sudokuOf (Block _ su) = su
+
+indexRange :: Region -> [Int]
+indexRange (Cell _ _) = [0]
+indexRange (Row _ _) = [0..8]
+indexRange (Col _ _) = [0..8]
+indexRange (Block _ _) = [0..8]
+
+-- Doesn't check sudoku equality
+cellIsIn :: Region -> Region -> Bool
+cellIsIn (Cell i _) (Cell j _) = i == j
+cellIsIn (Cell i _) (Row r _) = i `div` 9 == r
+cellIsIn (Cell i _) (Col c _) = i `mod` 9 == c
+cellIsIn (Cell i _) (Block b _) = (i `mod` 9) `div` 3 == b `mod` 3 && i `div` 27 == b `div` 3
+
+adaptRegion :: Region -> Sudoku -> Region
+adaptRegion (Cell i _) su = Cell i su
+adaptRegion (Row i _) su = Row i su
+adaptRegion (Col i _) su = Col i su
+adaptRegion (Block i _) su = Block i su
+
+
+class HasCells a where
+ cell :: Int -> a -> Region
+
+instance HasCells Sudoku where
+ cell i su | 0 <= i && i < 81 = Cell i su
+
+instance HasCells Region where
+ cell i (Row r su) | 0 <= i && i < 9 = Cell (9 * r + i) su
+ cell i (Col c su) | 0 <= i && i < 9 = Cell (9 * i + c) su
+ cell i (Block b su) | 0 <= i && i < 9 =
+ let bx = 3 * (b `mod` 3)
+ by = 3 * (b `div` 3)
+ in Cell (9 * (by + i `div` 3) + bx + i `mod` 3) su
+ cell 0 c@(Cell _ _) = c
+ cell _ _ = undefined
+
+
+class HasValues a where
+ values :: a -> [Value]
+
+instance HasValues Sudoku where
+ values (Sudoku l) = lefts l
+
+instance HasValues Region where
+ values (Cell i su) = maybe [] pure (su `atv` i)
+ values reg = concatMap values [cell i reg | i <- indexRange reg] -- row, col, block
+
+
+class UpdateValue a where
+ updateValue :: Int -> Value -> a -> Sudoku
+
+instance UpdateValue Sudoku where
+ updateValue i v su = update i (Left v) su
+
+instance UpdateValue Region where
+ updateValue 0 v (Cell j su) = update j (Left v) su
+ updateValue _ _ (Cell _ _) = undefined
+ updateValue i v reg = updateValue 0 v (cell i reg) -- row, col, block
+
+
+class MaskPoss a where
+ maskPoss :: a -> Poss -> Sudoku
+
+instance MaskPoss Region where
+ maskPoss (Cell i su) p = case su `at` i of
+ Left _ -> su
+ Right p' -> update i (Right (p `possAnd` p')) su
+ maskPoss row@(Row r _) p = sudokuOf $ foldl (\row' i -> Row r $ maskPoss (cell i row') p) row [0..8]
+ maskPoss col@(Col c _) p = sudokuOf $ foldl (\col' i -> Col c $ maskPoss (cell i col') p) col [0..8]
+ maskPoss blk@(Block b _) p = sudokuOf $ foldl (\blk' i -> Block b $ maskPoss (cell i blk') p) blk [0..8]
+
+
+readSudoku :: String -> Sudoku
+readSudoku s = Sudoku $ flip map (words s) $ \w -> case w of
+ "." -> Right (Poss $ replicate 9 True)
+ [c] | '1' <= c && c <= '9' -> Left (ord c - ord '1')
+ _ -> error "Invalid sudoku input"
+
+writeSudokuGeneric :: Sudoku -> Bool -> String
+writeSudokuGeneric su full =
+ intercalate "\n"
+ [testinter n "\n" ++
+ intercalate " "
+ (map (\i -> testinter i " " ++ printone (su `atv` i) ++ printposs (su `atp` i)) [9*n..9*n+8])
+ | n <- [0..8]]
+ where
+ printone :: Maybe Value -> String
+ printone Nothing = "."
+ printone (Just n) = show (n + 1)
+
+ printposs :: Poss -> String
+ printposs (Poss m) =
+ let s = map snd $ filter fst $ zip m ['1'..'9']
+ padded = replicate (9 - length s) ' ' ++ s
+ in if full then "(" ++ padded ++ ")" else ""
+
+ testinter :: Int -> String -> String
+ testinter i s = let n = i `mod` 9 in if n > 0 && n `mod` 3 == 0 then s else ""
+
+writeSudoku :: Sudoku -> String
+writeSudoku su = writeSudokuGeneric su False
+
+writeSudokuFull :: Sudoku -> String
+writeSudokuFull su = writeSudokuGeneric su True
+
+writeSudokuDiff :: Sudoku -> Sudoku -> String
+writeSudokuDiff su1 su2 =
+ intercalate "\n" $ flip map [0..8] $ \r ->
+ let line = flip concatMap [0..8] $ \c ->
+ (if c > 1 && c `mod` 3 == 0 then " " else "")
+ ++ (if c > 1 then " " else "")
+ ++ case (su1 `at` (9 * r + c), su2 `at` (9 * r + c)) of
+ (Left v1, Left v2) | v1 == v2 -> show (v2 + 1) ++ printposs pe pe
+ | otherwise -> high (show (v2 + 1)) ++ printposs pe pe
+ (Left _, Right p) -> high ("." ++ printposs p p)
+ (Right _, Left v) -> high (show (v + 1) ++ printposs pe pe)
+ (Right p1, Right p2) -> "." ++ printposs p1 p2
+ in (if r > 1 && r `mod` 3 == 0 then "\n" else "") ++ line
+ where
+ high :: String -> String
+ high s = "\x1B[41;1m" ++ s ++ "\x1B[0m"
+
+ pe :: Poss
+ pe = listPoss []
+
+ printposs :: Poss -> Poss -> String
+ printposs (Poss m1) (Poss m2) =
+ let s = flip concatMap [0..8] $ \i -> case (m1 !! i, m2 !! i) of
+ (True, True) -> show (i + 1)
+ (True, False) -> high "."
+ (False, True) -> high (show (i + 1))
+ (False, False) -> " "
+ in "(" ++ s ++ ")"
+
+
+data Action = AResolve Int Value Reason
+ | AScratch Int Value Reason
+ deriving (Show)
+
+data Reason = RCell | RRow | RCol | RBlock
+ | RCellI Int | RRowI Int | RColI Int | RBlockI Int
+ | RCombine Reason Reason
+ deriving (Show)
+
+type SM = Writer [Action]
+
+reasonReg :: Region -> Reason
+reasonReg (Cell i _) = RCellI i
+reasonReg (Row r _) = RRowI r
+reasonReg (Col c _) = RColI c
+reasonReg (Block b _) = RBlockI b
+
+writeAction :: Action -> String
+writeAction (AResolve i n reason) =
+ "Resolved cell " ++ actionCellString i ++ " to value " ++ show (n + 1) ++ " (" ++ writeReason reason ++ ")"
+writeAction (AScratch i n reason) =
+ "Scratched possibility for " ++ show (n + 1) ++ " in cell " ++ actionCellString i ++ " (" ++ writeReason reason ++ ")"
+
+actionCellString :: Int -> String
+actionCellString i = "(" ++ show (i `mod` 9) ++ "," ++ show (i `div` 9) ++ ")"
+
+writeReason :: Reason -> String
+writeReason RCell = "cell"
+writeReason RRow = "row"
+writeReason RCol = "column"
+writeReason RBlock = "block"
+writeReason (RCellI i) = "situation in cell " ++ show i
+writeReason (RRowI i) = "situation in row " ++ show i
+writeReason (RColI i) = "situation in column " ++ show i
+writeReason (RBlockI i) = "situation in block " ++ show i
+writeReason (RCombine a b) = writeReason a ++ "; " ++ writeReason b
+
+
+scratchInRegionExcept :: Value -> Region -> Region -> Reason -> SM Sudoku
+scratchInRegionExcept val reg except reason =
+ foldM (\su i ->
+ let cl = cell i (adaptRegion reg su)
+ in if cl `cellIsIn` except
+ then return su
+ else if val `possElem` possOf cl
+ then let su' = maskPoss cl (possMakeAllExcept val)
+ in tell [AScratch (indexOf cl) val reason] >> return su'
+ else return su)
+ (sudokuOf reg) (indexRange reg)
+
+
+scratchPossBasic :: Sudoku -> (Sudoku, [Action])
+scratchPossBasic su =
+ let su1 = foldl (\su' regc -> scratchPossBasicRegion (regc su'))
+ su (concat [[Row i, Col i, Block i] | i <- [0..8]])
+ in (su1, [])
+
+scratchPossBasicRegion :: Region -> Sudoku
+scratchPossBasicRegion reg = maskPoss reg (listPoss $ [0..8] \\ values reg)
+
+scratchAroundCell :: Region -> Sudoku
+scratchAroundCell cl@(Cell _ _) =
+ let su1 = scratchPossBasicRegion (rowOf cl)
+ su2 = scratchPossBasicRegion (colOf (adaptRegion cl su1))
+ su3 = scratchPossBasicRegion (blockOf (adaptRegion cl su2))
+ in su3
+
+scratchPossIndirectB :: Sudoku -> (Sudoku, [Action])
+scratchPossIndirectB su = runWriter $ foldM bfunc su [0..8]
+ where
+ bfunc :: Sudoku -> Int -> SM Sudoku
+ bfunc su' bi =
+ let rowAllowed = flip map [0..2] $
+ \i -> [possOf $ cell (3 * i + j) (Block bi su') | j <- [0..2]]
+ colAllowed = flip map [0..2] $
+ \i -> [possOf $ cell (3 * j + i) (Block bi su') | j <- [0..2]]
+ rowIndices = scratchPairsFromAllowed rowAllowed
+ colIndices = scratchPairsFromAllowed colAllowed
+ in do
+ rowsu <- foldM (\su1 (i,n) -> -- i: row number in block; n: value
+ scratchInRegionExcept n (rowOf (cell (3 * i) (Block bi su1)))
+ (Block bi su1) (RCombine (reasonReg (Block bi su1)) RRow))
+ su' rowIndices
+ colsu <- foldM (\su1 (i,n) -> -- i: row number in block; n: value
+ scratchInRegionExcept n (colOf (cell i (Block bi su1)))
+ (Block bi su1) (RCombine (reasonReg (Block bi su1)) RCol))
+ rowsu colIndices
+ return colsu
+
+ -- return [(index, n)] for all the n that occur in only one blockrow
+ scratchPairsFromAllowed :: [[Poss]] -> [(Int, Value)]
+ scratchPairsFromAllowed plists =
+ let allowed = map (foldl1 possOr) plists
+ in catMaybes $
+ map (\(mi,n) -> maybe Nothing (\i -> Just (i,n)) mi) $
+ -- v [(Just index if n exists in only one blockrow and else Nothing, n)]
+ zip (map (possGetIfInOne allowed) [0..8]) [0..8]
+
+resolveCells :: Sudoku -> (Sudoku, [Action])
+resolveCells su = runWriter $ foldM func su [0..80]
+ where
+ func :: Sudoku -> Int -> SM Sudoku
+ func su' i = case possList (su' `atp` i) of
+ [n] -> do
+ tell [AResolve i n RCell]
+ let su1 = updateValue i n su'
+ return $ scratchAroundCell (cell i su1)
+ _ -> return su'
+
+resolveRegions :: Sudoku -> (Sudoku, [Action])
+resolveRegions su = runWriter $ foldM func su [f i | f <- [Row, Col, Block], i <- [0..8]]
+ where
+ func :: Sudoku -> (Sudoku -> Region) -> SM Sudoku
+ func su' regc =
+ foldM (\su1 n ->
+ let reg = regc su1
+ ps = map possOf [cell i reg | i <- indexRange reg]
+ in case possGetIfInOne ps n of
+ Nothing -> return su1
+ Just i -> do
+ let su_i = indexOf (cell i reg)
+ tell [AResolve su_i n (reasonReg reg)]
+ let su2 = updateValue i n reg
+ return $ scratchAroundCell (cell su_i su2))
+ su' [0..8]
+
+
+operations :: [Sudoku -> (Sudoku, [Action])]
+operations = [
+ scratchPossBasic, scratchPossIndirectB,
+ resolveCells,
+ resolveRegions]
+
+solve :: Sudoku -> [(Sudoku, [Action])]
+solve su =
+ let l = tail $ go su operations
+ (su', _) = last l
+ in if su' == su then [] else l ++ solve su'
+ where
+ go :: Sudoku -> [Sudoku -> (Sudoku, [Action])] -> [(Sudoku, [Action])]
+ go su1 ops = scanl (\(su2, _) op -> op su2) (su1, []) ops
+
+main :: IO ()
+main = do
+ su <- liftM readSudoku getContents
+
+ let useBT = True
+ btSols = backtrackSolve su
+
+ when useBT $
+ case btSols of
+ [] -> do
+ die "Cannot solve sudoku using backtracking"
+ list -> do
+ putStrLn $ "Backtracking gave " ++ show (length list) ++ " solutions:"
+ forM_ list $ \res -> do
+ putStrLn $ writeSudoku res
+ putStr "\n"
+
+ let reslist = (su, []) : solve su
+ suRes = fst (last reslist)
+
+ putStrLn (writeSudokuFull su)
+
+ mapM_ (\((su', acts), (prevsu, _)) -> do
+ putStr "\n\n"
+ mapM_ (putStrLn . writeAction) acts
+ -- print acts
+ putStrLn (writeSudokuDiff prevsu su'))
+ (zip (tail reslist) reslist)
+
+ putStrLn (writeSudoku suRes)
+ putStr "\n"
+
+ when useBT $
+ when (length btSols /= 1 || suRes /= btSols !! 0) $
+ die "Incorrectly solved!"
diff --git a/hsolve/hsolve.cabal b/hsolve/hsolve.cabal
new file mode 100644
index 0000000..4489d0b
--- /dev/null
+++ b/hsolve/hsolve.cabal
@@ -0,0 +1,16 @@
+name: hsolve
+version: 0.1.0
+cabal-version: >= 1.10
+build-type: Simple
+license: MIT
+author: Tom Smeding
+maintainer: tom.smeding@gmail.com
+
+executable hsolve
+ hs-source-dirs: .
+ main-is: Main.hs
+ default-language: Haskell2010
+ ghc-options: -Wall -O3 -Wno-incomplete-patterns
+ other-modules: FSu
+ build-depends: base >= 4 && < 5,
+ mtl, array
diff --git a/hsolve/stack.yaml b/hsolve/stack.yaml
new file mode 100644
index 0000000..eb2d377
--- /dev/null
+++ b/hsolve/stack.yaml
@@ -0,0 +1,65 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-12.5
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+# git: https://github.com/commercialhaskell/stack.git
+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# subdirs:
+# - auto-update
+# - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# using the same syntax as the packages field.
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor \ No newline at end of file
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-22 04:54:04 +0100