/
Main.hs
156 lines (133 loc) · 5.65 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
{-# OPTIONS -cpp #-}
module Main where
{-
This file is part of funsat.
funsat is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
funsat is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with funsat. If not, see <http://www.gnu.org/licenses/>.
Copyright 2008 Denis Bueno
-}
import Control.Monad ( when, forM_ )
import Data.Foldable ( fold, toList, elem )
import Data.List ( intercalate )
import Data.Monoid
import Data.Set ( Set )
import Funsat.Solver
( solve
, verify
, DPLLConfig(..)
, defaultConfig
, ShowWrapped(..)
, statTable )
import Funsat.Types( CNF, GenCNF(..) )
import Prelude hiding ( elem )
import System.Console.GetOpt
import System.Environment ( getArgs )
import System.Exit ( ExitCode(..), exitWith )
import Data.Time.Clock
import qualified Data.Set as Set
import qualified Language.CNF.Parse.ParseDIMACS as ParseCNF
import qualified Text.Tabular as Tabular
#ifdef TESTING
import qualified Properties
#endif
data Feature = WatchedLiterals
| ClauseLearning
| Restarts
| VSIDS
deriving (Eq, Ord)
instance Show Feature where
show WatchedLiterals = "watched literals"
show ClauseLearning = "conflict clause learning"
show Restarts = "restarts"
show VSIDS = "dynamic variable ordering"
allFeatures :: Set Feature
allFeatures = Set.fromList [WatchedLiterals, ClauseLearning, Restarts, VSIDS]
validOptions :: [OptDescr RunOptions]
validOptions =
[ Option [] ["no-vsids"] (NoArg $ disableF VSIDS)
"Use static variable ordering."
, Option [] ["no-restarts"] (NoArg $ disableF Restarts)
"Never restart."
, Option [] ["verify"] (NoArg RunTests)
"Run quickcheck properties and unit tests."
, Option [] ["print-features"] (NoArg (PrintFeatures Set.empty))
"Print the optimisations the SAT solver supports." ]
disableF :: Feature -> RunOptions
disableF = Disable . Set.singleton
data RunOptions = Disable (Set Feature) -- disable certain features
| RunTests -- run unit tests
| PrintFeatures (Set Feature) -- disable certain features
-- Combines features, choosing only RunTests and PrintFeatures if present,
-- otherwise combining sets of features to disable.
instance Monoid RunOptions where
mempty = Disable Set.empty
mappend (PrintFeatures f) (PrintFeatures f') = PrintFeatures (f `Set.union` f')
mappend (PrintFeatures f) (Disable f') = PrintFeatures (f `Set.union` f')
mappend o@(PrintFeatures _) _ = o
mappend o@RunTests _ = o
mappend (Disable s) (Disable s') = Disable (s `Set.union` s')
mappend (Disable _) o = o -- non-feature selection options override
parseOptions :: [String] -> IO (RunOptions, [FilePath])
parseOptions args = do
let (runoptionss, filepaths, errors) = getOpt RequireOrder validOptions args
when (not (null errors)) $ do { mapM_ putStr errors ;
putStrLn (usageInfo usageHeader validOptions) ;
exitWith (ExitFailure 1) }
return $ (fold runoptionss, filepaths)
main :: IO ()
main = do
(opts, files) <- getArgs >>= parseOptions
case opts of
#ifdef TESTING
RunTests -> Properties.main
#endif
PrintFeatures disabled ->
putStrLn $ intercalate ", " $ map show $
toList (allFeatures Set.\\ disabled)
Disable features -> do
putStr "Enabled features: "
putStrLn $ intercalate ", " $ map show $
toList (allFeatures Set.\\ features)
forM_ files $ \path -> readFile path >>= parseAndSolve path
where
parseAndSolve path contents = do
let cnf = asCNF $ ParseCNF.parseCNF path contents
putStrLn $ show (numVars cnf) ++ " variables, "
++ show (numClauses cnf) ++ " clauses"
Set.map seqList (clauses cnf)
`seq` putStrLn ("Solving " ++ path ++ "...")
startingTime <- getCurrentTime
let cfg =
(defaultConfig cnf)
{ configUseVSIDS = not $ VSIDS `elem` features
, configUseRestarts = not $ Restarts `elem` features }
(solution, stats, rt) = solve cfg cnf
endingTime <- solution `seq` getCurrentTime
print solution
print $ statTable stats `Tabular.combine`
Tabular.mkTable
[[ WrapString "Real time "
, WrapString $ show (diffUTCTime endingTime startingTime)]]
putStr "Verifying solution..."
case verify solution rt cnf of
Just errorWitness ->
do putStrLn "\n--> VERIFICATION ERROR!"
print errorWitness
Nothing -> putStrLn "succeeded."
usageHeader = "Usage: funsat [options] <cnf-filename> ... <cnf-filename>"
seqList l@[] = l
seqList l@(x:xs) = x `seq` seqList xs `seq` l
-- | Convert parsed CNF to internal representation.
asCNF :: ParseCNF.CNF -> CNF
asCNF (ParseCNF.CNF v c is) =
CNF { numVars = v
, numClauses = c
, clauses = Set.fromList . map (map fromIntegral) $ is }