packages feed

clingo (empty) → 0.2.0.0

raw patch · 52 files changed

+9082/−0 lines, 52 filesdep +MonadRandomdep +StateVardep +basesetup-changed

Dependencies added: MonadRandom, StateVar, base, bifunctors, clingo, containers, deepseq, exceptions, hashable, monad-loops, mtl, text, transformers, wl-pprint-text

Files

+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)+Copyright © 2017 Paul Ogris++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the “Software”), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ clingo.cabal view
@@ -0,0 +1,197 @@+name:                clingo+version:             0.2.0.0+synopsis:            Haskell bindings to the Clingo ASP solver+description:         Please see README.md+homepage:            https://github.com/tsahyt/clingo-haskell#readme+license:             MIT+license-file:        LICENSE+author:              Paul Ogris+maintainer:          paul@tsahyt.com+copyright:           2017 Paul Ogris+category:            ASP, Symbolic Computation, Logic Programming, FFI+build-type:          Simple+cabal-version:       >=1.10++flag examples+  description:       Build examples+  default:           False++library+  hs-source-dirs:      src+  exposed-modules:     Clingo+                       Clingo.AST+                       Clingo.Configuration+                       Clingo.Control+                       Clingo.Inspection.Symbolic+                       Clingo.Inspection.Theory+                       Clingo.Inspection.Ground+                       Clingo.Model+                       Clingo.ProgramBuilding+                       Clingo.Propagation+                       Clingo.Solving+                       Clingo.Statistics+                       Clingo.Symbol+                       Clingo.Internal.AST+                       Clingo.Internal.Configuration+                       Clingo.Internal.Inspection.Symbolic+                       Clingo.Internal.Inspection.Theory+                       Clingo.Internal.Propagation+                       Clingo.Internal.Statistics+                       Clingo.Internal.Symbol+                       Clingo.Internal.Types+                       Clingo.Internal.Utils+                       Clingo.Raw+                       Clingo.Raw.AST+                       Clingo.Raw.Basic+                       Clingo.Raw.Configuration+                       Clingo.Raw.Control+                       Clingo.Raw.Enums+                       Clingo.Raw.Inspection.Symbolic+                       Clingo.Raw.Inspection.Theory+                       Clingo.Raw.Model+                       Clingo.Raw.ProgramBuilding+                       Clingo.Raw.Propagation+                       Clingo.Raw.Solving+                       Clingo.Raw.Statistics+                       Clingo.Raw.Symbol+                       Clingo.Raw.Types+  build-depends:       base >= 4.7 && < 5,+                       bifunctors >= 5.4 && < 6,+                       transformers == 0.5.*,+                       mtl == 2.2.*,+                       exceptions == 0.8.*,+                       text == 1.2.*,+                       wl-pprint-text,+                       deepseq == 1.4.*,+                       StateVar == 1.1.*,+                       hashable == 1.2.*+  extra-libraries:     clingo+  ghc-options:         -Wall+  default-language:    Haskell2010++executable version+  if flag(examples)+      build-depends:   base, clingo+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Version.hs+  default-language:    Haskell2010++executable dot-propagator+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             DotPropagator.hs+  default-language:    Haskell2010++executable control+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Control.hs+  default-language:    Haskell2010++executable configuration+  if flag(examples)+      build-depends:   base, clingo, text, StateVar+  else +      buildable:       False++  hs-source-dirs:      examples+  ghc-options:         -Wall+  main-is:             Configuration.hs+  default-language:    Haskell2010++executable theory-atoms+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             TheoryAtoms.hs+  default-language:    Haskell2010++executable symbolic-atoms+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             SymbolicAtoms.hs+  default-language:    Haskell2010++executable ast+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             AST.hs+  default-language:    Haskell2010++executable backend+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Backend.hs+  default-language:    Haskell2010++executable model+  if flag(examples)+      build-depends:   base, clingo, text+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Model.hs+  default-language:    Haskell2010++executable solve-async+  if flag(examples)+      build-depends:   base, clingo, text, monad-loops, MonadRandom+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             SolveAsync.hs+  ghc-options:         -threaded+  default-language:    Haskell2010++executable statistics+  if flag(examples)+      build-depends:   base, clingo, text, wl-pprint-text, StateVar+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Statistics.hs+  default-language:    Haskell2010++executable propagator+  if flag(examples)+      build-depends:   base, clingo, text, containers, transformers+  else +      buildable:       False++  hs-source-dirs:      examples+  main-is:             Propagator.hs+  default-language:    Haskell2010+++source-repository head+  type:     git+  location: https://github.com/tsahyt/clingo-haskell
+ examples/AST.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class++import Clingo.AST+import Clingo.Control+import Clingo.Model+import Clingo.ProgramBuilding+import Clingo.Symbol+import Clingo.Solving++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)++rewrite :: Term a -> Statement a b -> Statement a b+rewrite a@(TermSymbol loc sym) (StmtRule l (Rule h b)) = +    let lit = BodyLiteral loc NoSign (LiteralTerm loc NoSign a)+     in StmtRule l (Rule h (lit : b))+rewrite _ x = x++main :: IO ()+main = withDefaultClingo $ do+    builder <- programBuilder++    -- create enable atom+    sym  <- createId "enable" True+    let loc  = Location "<rewrite>" "<rewrite>" 0 0 0 0+        atom = TermSymbol loc sym++    -- add rewritten statements into the builder+    addStatements builder . map (rewrite atom)+        =<< parseProgram "a :- not b. b :- not a." Nothing 20++    -- add #external enable.+    addStatements builder [ StmtExternal loc (External atom []) ]++    ground [Part "base" []] Nothing++    liftIO $ putStrLn "Solving with enable = false..."+    withSolver [] (allModels >=> mapM_ printModel)++    liftIO $ putStrLn "Solving with enable = true..."+    assignExternal sym TruthTrue+    withSolver [] (allModels >=> mapM_ printModel)++    liftIO $ putStrLn "Solving with enable = false..."+    assignExternal sym TruthFalse+    withSolver [] (allModels >=> mapM_ printModel)
+ examples/Backend.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Solving+import Clingo.Model+import Clingo.ProgramBuilding+import Clingo.Inspection.Symbolic++import Text.Printf+import qualified Data.Text.IO as T++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "base" [] "{a; b; c}."+    ground [Part "base" []] Nothing++    atoms <- flip fromSymbolicAtoms (map literal) =<< symbolicAtoms+    backend >>= \b -> do+        atomD <- atom b+        addGroundStatements b+            [ rule False [atomD] (take 2 atoms)+            , rule False [] +                  [ negateAspifLiteral (atomAspifLiteral atomD)+                  , atoms !! 2]+            ]++    withSolver [] (allModels >=> mapM_ printModel)
+ examples/Configuration.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Configuration+import Clingo.Symbol+import Clingo.Solving+import Clingo.Model++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)++(>>?=) :: (Monad m, Foldable t) => m (t a) -> (a -> m b) -> m ()+a >>?= b = a >>= mapM_ b+    +main :: IO ()+main = withDefaultClingo $ do+    conf <- configuration++    -- enumerate all models+    fromConfig conf (atMap "solve" >=> atMap "models" >=> value) >>?= ($= "0")++    -- use berkmin+    fromConfig conf (atMap "solver" >=> atArray 0 >=> atMap "heuristic" +                      >=> value)+        >>?= ($= "berkmin")+    +    addProgram "base" [] "a :- not b. b :- not a."+    ground [Part "base" []] Nothing+    withSolver [] (allModels >=> mapM_ printModel)
+ examples/Control.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Model+import Clingo.Solving++import Text.Printf+import qualified Data.Text.IO as T++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "base" [] "a :- not b. b :- not a."+    ground [Part "base" []] Nothing+    withSolver [] (allModels >=> mapM_ printModel)
+ examples/DotPropagator.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+module Main where++import Control.Monad.IO.Class+import Control.Monad+import Control.Concurrent+import Clingo.Control+import Clingo.Solving+import Clingo.Propagation+import Clingo.Inspection.Symbolic++import System.Environment (getArgs)+import System.IO (hFlush, stdout)++sleepTime :: Int+sleepTime = 10000++mapIO :: (MonadIO m, Foldable t) => IO b -> t a -> m ()+mapIO = mapM_ . const . liftIO++writeDots :: [Literal s] -> Propagation 'Solving s ()+writeDots = mapIO (putChar '.' >> hFlush stdout >> threadDelay sleepTime)++takeDots :: [Literal s] -> Propagation 'Solving s ()+takeDots = mapIO (putStr "\b \b" >> hFlush stdout >> threadDelay sleepTime)++watchAll :: Propagation 'Init s ()+watchAll = mapM_ ((addWatch =<<) . solverLiteral . literal)+           =<< flip fromSymbolicAtoms id =<< propSymbolicAtoms++main :: IO ()+main = withDefaultClingo $ do+    path <- head <$> liftIO getArgs+    registerPropagator False $ emptyPropagator+        { propInit = Just watchAll+        , propPropagate = Just writeDots+        , propUndo = Just takeDots+        }+    loadProgram path+    ground [Part "base" []] Nothing+    withSolver [] (void . allModels)+    liftIO (putChar '\n')
+ examples/Model.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Model+import Clingo.Solving+import Data.List (intersperse)+import Data.Text (Text)+import System.Environment (getArgs)++import Text.Printf+import qualified Data.Text.IO as T++printModel :: Model s -> Text -> SymbolSelection -> IOSym s ()+printModel m label s = do+    syms <- map prettySymbol <$> modelSymbols m s+    liftIO $ do+        T.putStr (label `mappend` ": ")+        T.putStrLn . mconcat $ intersperse " " syms++printSolution :: Model s -> IOSym s ()+printSolution m = do  +    t <- modelType m+    n <- modelNumber m+    let tstring = case t of+            StableModel -> "Stable model"+            BraveConsequences -> "Brave consequences"+            CautiousConsequences -> "Cautious consequences"++    liftIO (printf "%s %d:\n" (tstring :: String) n)+    mapM_ (uncurry (printModel m)) +        [ ("  shown", selectNone { selectShown = True })+        , ("  atoms", selectNone { selectAtoms = True })+        , ("  terms", selectNone { selectTerms = True })+        , (" ~atoms", selectNone { selectAtoms = True+                                 , useComplement = True })+        ]+    +main :: IO ()+main = getArgs >>= \args -> +    withClingo (defaultClingo { clingoArgs = args }) $ do+        addProgram "base" [] "1 {a; b} 1. #show c : b. #show a/0."+        ground [Part "base" []] Nothing+        withSolver [] (allModels >=> mapM_ printSolution)
+ examples/Propagator.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternGuards #-}+module Main where++import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Solving+import Clingo.Model+import Clingo.Propagation+import Clingo.Inspection.Symbolic++import Data.Map (Map)+import Data.Maybe+import Data.IntMap (IntMap)+import qualified Data.Map as M+import qualified Data.IntMap as I++import Text.Printf+import qualified Data.Text.IO as T++newtype Hole = Hole Int+    deriving (Eq, Show, Ord)++data PigeonData s = PigeonData+    { placements  :: Map (Literal s) Hole+    , assignments :: IntMap (Map Hole (Literal s))+    }+    deriving (Show)++assignHole :: Integer -> Hole -> Literal s -> PigeonData s -> PigeonData s+assignHole tid hole lit pd = pd +    { assignments = +        I.adjust (M.insert hole lit) (fromIntegral tid) (assignments pd) }++unassignHole :: Integer -> Literal s -> Hole -> PigeonData s -> PigeonData s+unassignHole tid lit hole pd = pd+    { assignments = I.adjust go (fromIntegral tid) (assignments pd) }+    where go m | Just l <- M.lookup hole m+               , l == lit  = M.delete hole m+               | otherwise = m++forceMVar :: MonadIO m => MVar a -> a -> m ()+forceMVar mvar x = liftIO $ do+    _ <- tryTakeMVar mvar+    putMVar mvar x++onModel :: Model s -> IOSym s Continue+onModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)+    return Continue+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "pigeon" ["h","p"] +        "1 { place(P,H) : H = 1..h } 1 :- P = 1..p."++    holes <- createNumber 8+    pigeons <- createNumber 9+    ground [Part "pigeon" [holes, pigeons]] Nothing++    propState <- liftIO newEmptyMVar+    registerPropagator False (pigeonator propState)++    solveRet <- withSolver [] getResult+    liftIO (print solveRet)++-- TODO: Propagator with symbol inspection methods?+pigeonator :: MVar (PigeonData s) -> Propagator s+pigeonator mvar = emptyPropagator+    { propInit = Just $ do+        -- obtain place/2 atoms+        placeSig <- createSignature "place" 2 True+        watches <- propSymbolicAtoms +               >>= \sa -> fromSymbolicAtomsSig sa placeSig id++        -- watch and create initial placements+        mapM_ ((addWatch =<<) . solverLiteral . literal) watches+        ps <- forM watches $ \atom -> do+                  let hole = do +                             arg <- symbolGetArg (symbol atom) 1+                             Hole . fromIntegral <$> symbolNumber arg+                  lit <- solverLiteral . literal $ atom+                  return $ (,) <$> pure lit <*> hole++        -- initialize the PigeonData structure for all threads+        threads <- fromIntegral <$> countThreads+        forceMVar mvar $ +            let xs = zip (take threads [0..]) (repeat M.empty)+             in PigeonData (M.fromList . catMaybes $ ps) (I.fromList xs)++    , propPropagate = Just $ \changes -> do+        -- get previous assignment+        thread <- getThreadId++        -- apply and check assignments done by solver+        forM_ changes $ \lit -> do+            state  <- liftIO (readMVar mvar)+            let Just holes = fromIntegral thread `I.lookup` assignments state+                Just hole = lit `M.lookup` placements state+                prev = hole `M.lookup` holes+            case prev of+                Nothing -> liftIO $+                    modifyMVar_ mvar (return . assignHole thread hole lit)+                Just p -> do+                    let c = Clause (map negateLiteral [lit, p]) ClauseLearnt+                    addClause c+                    propagate++    , propUndo = Just $ \changes -> do+        thread <- getThreadId+        state  <- liftIO (readMVar mvar)++        let cs' = mapMaybe +                      (\l -> (,) <$> pure l <*> M.lookup l (placements state))+                      changes+        liftIO $ +            modifyMVar_ mvar $+            return . flip (foldr (uncurry (unassignHole thread))) cs'+    }
+ examples/SolveAsync.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Random+import Control.Monad.Loops+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Solving+import Clingo.Model+import Data.IORef++import Text.Printf+import qualified Data.Text.IO as T++-- | Approximate Pi with a rather literal translation of the C example.+approxPi :: MonadIO m => MVar Bool -> m Double+approxPi running = liftIO $ do+    let rmax = 512+    samples <- newIORef 0+    incircle <- newIORef 0+    whileM (readMVar running) $ do+        modifyIORef' samples succ+        (x :: Int) <- getRandomR (-rmax, rmax)+        (y :: Int) <- getRandomR (-rmax, rmax)+        when (x * x + y * y <= rmax * rmax) $+            modifyIORef' incircle succ+    s <- readIORef samples+    c <- readIORef incircle+    return $ 4 * fromIntegral c / fromIntegral s+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "base" [] $+        "#const n = 17.\+       \ 1 { p(X); q(X) } 1 :- X = 1..n.\+       \ :- not n+1 { p(1..n); q(1..n) }."+    ground [Part "base" []] Nothing++    running <- liftIO (newMVar True)+    solver  <- solve SolveModeAsync [] $ Just $ \_ -> do+                   void (liftIO (swapMVar running False))+                   return Continue++    pi <- approxPi running+    liftIO (putStrLn $ "pi = " ++ show pi)+    liftIO . print =<< getResult solver++    solverClose solver
+ examples/Statistics.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad.IO.Class+import Clingo.Symbol+import Clingo.Solving+import Clingo.Control+import Clingo.Configuration+import Clingo.Model+import Clingo.Statistics++import Data.StateVar++import Data.Text.Lazy (fromStrict)+import Text.PrettyPrint.Leijen.Text hiding ((<$>))++instance Pretty v => Pretty (StatsTree v) where+    pretty (SValue v) = pretty v+    pretty (SArray x) = vcat $ map (nest 1 . pretty . snd) x+    pretty (SMap s)   = vcat $ map (nest 1 . go) s+        where go (k,t) = text (fromStrict k) <> colon <> line +                      <> nest 1 (pretty t)++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)++main :: IO ()+main = withDefaultClingo $ do+    -- Set configuration to put out more stats+    Just sconfig <- flip fromConfig (atMap "stats" >=> value) =<< configuration+    sconfig $= "1"++    -- Ground and solve a simple program+    addProgram "base" [] "a :- not b. b :- not a."+    ground [Part "base" []] Nothing+    _ <- withSolver [] (allModels >=> mapM_ printModel)+    stats <- statistics++    -- Print whole stats tree+    liftIO (putStrLn "\nStatistics")+    fullTree <- subStats stats pure+    liftIO (putDoc (pretty fullTree <> line))++    -- Print just the solving subtree+    liftIO (putStrLn "\nSelected solving.solver statistics")+    solving <- subStats stats (atMap "solving" >=> atMap "solvers")+    liftIO (putDoc (pretty solving <> line))++    -- Selecting only number of equations+    liftIO (putStrLn "\nNumber of equations")+    eqs <- fromStats stats (atMap "problem" >=> atMap "lp" >=> atMap "eqs"+                            >=> value)+    liftIO (putDoc (pretty eqs <> line))
+ examples/SymbolicAtoms.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Arrow+import Control.Monad+import Control.Monad.IO.Class+import Clingo.Control+import Clingo.Symbol+import Clingo.Model+import Clingo.Inspection.Symbolic++import Data.Maybe+import Data.Text (Text)++import qualified Data.Text.IO as T++printSymbol :: SymbolicAtom s -> Text+printSymbol atom =+    let isFact = guard (fact atom) *> pure ", fact"+        isExternal = guard (external atom) *> pure ", external"+        name = prettySymbol (symbol atom)+     in mconcat . catMaybes $ [ Just "  ", Just name, isFact, isExternal ]+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "base" [] "a. {b}. #external c."+    ground [Part "base" []] Nothing++    liftIO (T.putStrLn "Symbolic Atoms:")+    sa <- symbolicAtoms +    mapM_ (liftIO . T.putStrLn . printSymbol) =<< fromSymbolicAtoms sa id
+ examples/TheoryAtoms.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Monad.IO.Class+import Data.Maybe+import Clingo.Control+import Clingo.Symbol+import Clingo.Solving+import Clingo.Model+import Clingo.ProgramBuilding++import Text.Printf+import qualified Data.Text as T++import Clingo.Inspection.Theory++printModel :: (MonadIO (m s), MonadModel m) => Model s -> m s ()+printModel m = do+    syms <- map prettySymbol+        <$> modelSymbols m (selectNone { selectShown = True }) +    liftIO (putStr "Model: " >> print syms)++theory :: TheoryAtoms s -> Clingo s (AspifLiteral s)+theory t = do+    -- obtain number of theory atoms via length+    size <- fromTheoryAtoms t length +    liftIO (putStrLn $ "number of grounded theory atoms: " ++ show size)++    -- find the atom b/1 and determine whether it has a guard+    atomB <- fromTheoryAtoms t (head . filter (nameIs "b"))+    liftIO (putStrLn $ "theory atom b/1 has guard: " ++ +                       show (isJust . atomGuard $ atomB))++    return (atomLiteral atomB)++    where nameIs a x = case termName (atomTerm x) of+                           Nothing -> False+                           Just b  -> a == b+    +main :: IO ()+main = withDefaultClingo $ do+    addProgram "base" [] $ mconcat+        [ "#theory t {"+        , "  term   { + : 1, binary, left };"+        , "  &a/0 : term, any;"+        , "  &b/1 : term, {=}, term, any"+        , "}."+        , "x :- &a { 1+2 }."+        , "y :- &b(3) { } = 17." ]+    ground [Part "base" []] Nothing+    lit <- theory =<< theoryAtoms+    flip addGroundStatements [ assume [lit] ] =<< backend+    withSolver [] (allModels >=> mapM_ printModel)
+ examples/Version.hs view
@@ -0,0 +1,8 @@+module Main where++import Text.Printf+import Clingo.Control++main = do+    (a,b,c) <- version+    printf "Hello, this is clingo version %d.%d.%d.\n" a b c
+ src/Clingo.hs view
@@ -0,0 +1,13 @@+module Clingo+(+    module X+)+where++import Clingo.Control as X+import Clingo.Model as X+import Clingo.Solving as X+import Clingo.Symbol as X+import Clingo.Propagation as X+import Clingo.Statistics as X+import Clingo.Configuration as X
+ src/Clingo/AST.hs view
@@ -0,0 +1,121 @@+module Clingo.AST+(+    parseProgram,+    fromPureAST,+    toPureAST,++    T.Location (..),+    Sign (..),+    T.Signature,+    T.Symbol,+    UnaryOperation (..),+    UnaryOperator (..),+    BinaryOperation (..),+    BinaryOperator (..),+    Interval (..),+    Function (..),+    Pool (..),+    Term (..),+    CspProductTerm (..),+    CspSumTerm (..),+    CspGuard (..),+    ComparisonOperator (..),+    CspLiteral (..),+    Identifier (..),+    Comparison (..),+    Literal (..),+    AggregateGuard (..),+    ConditionalLiteral (..),+    Aggregate (..),+    BodyAggregateElement (..),+    BodyAggregate (..),+    AggregateFunction (..),+    HeadAggregateElement (..),+    HeadAggregate (..),+    Disjunction (..),+    DisjointElement (..),+    Disjoint (..),+    TheoryTermArray (..),+    TheoryFunction (..),+    TheoryUnparsedTermElement (..),+    TheoryUnparsedTerm (..),+    TheoryTerm (..),+    TheoryAtomElement (..),+    TheoryGuard (..),+    TheoryAtom (..),+    HeadLiteral (..),+    BodyLiteral (..),+    TheoryOperatorDefinition (..),+    TheoryOperatorType (..),+    TheoryTermDefinition (..),+    TheoryGuardDefinition (..),+    TheoryAtomDefinition (..),+    TheoryAtomDefinitionType (..),+    TheoryDefinition (..),+    Rule (..),+    Definition (..),+    ShowSignature (..),+    ShowTerm (..),+    Minimize (..),+    Script (..),+    ScriptType (..),+    Program (..),+    External (..),+    Edge (..),+    Heuristic (..),+    Project (..),+    Statement (..)+)+where++import Control.Monad.IO.Class++import Data.Bifunctor+import Data.Bitraversable+import Data.Text (Text, unpack)+import Data.IORef+import Numeric.Natural++import Foreign hiding (Pool)+import Foreign.C++import Clingo.Symbol+import Clingo.Internal.AST+import Clingo.Internal.Utils+import qualified Clingo.Internal.Types as T+import qualified Clingo.Raw as Raw++-- | Parse a logic program into a list of statements.+parseProgram :: Text                                    -- ^ Program+             -> Maybe (ClingoWarning -> Text -> IO ())  -- ^ Logger Callback+             -> Natural                                 -- ^ Logger Call Limit+             -> T.Clingo s [Statement (T.Symbol s) (T.Signature s)]+parseProgram prog logger limit = do+    ref <- liftIO (newIORef [])+    marshall0 $+        withCString (unpack prog) $ \p -> do+            logCB <- maybe (pure nullFunPtr) T.wrapCBLogger logger+            astCB <- wrapCBAst (\s -> modifyIORef ref (s :))+            Raw.parseProgram p astCB nullPtr +                               logCB nullPtr (fromIntegral limit)+    liftIO (reverse <$> readIORef ref)++-- | An AST can be constructed in a pure environment using 'PureSymbol' and+-- 'PureSignature' and then registered with the solver when required. Creation+-- calls for the same symbol in multiple places will be repeated, i.e. no symbol+-- table is being created internally by this function!+fromPureAST :: (Monad (m s), MonadSymbol m)+            => [Statement PureSymbol PureSignature]+            -> m s [Statement (T.Symbol s) (T.Signature s)]+fromPureAST = traverse (bitraverse unpureSymbol unpureSignature)++toPureAST :: [Statement (T.Symbol s) (T.Signature s)]+          -> [Statement PureSymbol PureSignature]+toPureAST = fmap (bimap toPureSymbol toPureSignature)++wrapCBAst :: MonadIO m+          => (Statement (T.Symbol s) (T.Signature s) -> IO ())+          -> m (FunPtr (Ptr Raw.AstStatement -> Ptr () -> IO Raw.CBool))+wrapCBAst f = liftIO $ Raw.mkCallbackAst go+    where go :: Ptr Raw.AstStatement -> Ptr () -> IO Raw.CBool+          go stmt _ = reraiseIO $ f =<< fromRawStatement =<< peek stmt
+ src/Clingo/Configuration.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Configuration+(+    -- * Tree interface+    ConfTree (..),+    AMVTree (..),+    (>=>),+    fromConfig,+    fromConfigMany,++    -- * Re-exported from StateVar+    StateVar,+    ($=),+    get+)+where++import Control.DeepSeq+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Bifunctor+import Data.Text (Text)+import Data.StateVar++import GHC.Generics++import Clingo.Internal.Types+import Clingo.Internal.Configuration++import System.IO.Unsafe++-- | The configuration tree type, polymorphic over the leaf values.+data ConfTree v+    = CValue v+    | CMap (Maybe v)   [(Text, ConfTree v)]+    | CArray (Maybe v) [(Int, ConfTree v)]+    | CBoth (Maybe v)  [((Text, Int), ConfTree v)]+    deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic)++instance NFData v => NFData (ConfTree v)++getTree :: (MonadIO m, MonadThrow m) +        => Configuration s -> m (ConfTree (StateVar Text))+getTree s = configurationRoot s >>= liftIO . go+    where go k = unsafeInterleaveIO $ do+              t <- configurationType s k+              case t of+                  -- Both constructors+                  CType val True True -> do+                      len <- configurationArraySize s k+                      (nms, cs, os) <- goMap len k+                      return . CBoth (getVal val k) $+                          zip (zip nms (map fromIntegral os)) cs++                  -- Array constructor+                  CType val True False -> do+                      len <- configurationArraySize s k+                      let offsets = take (fromIntegral len) [0..]+                      cs  <- mapM (go <=< configurationArrayAt s k) offsets+                      return . CArray (getVal val k) $+                          zip (map fromIntegral offsets) cs++                  -- Map constructor+                  CType val False True -> do+                      len <- configurationMapSize s k+                      (nms, cs, _) <- goMap len k+                      return $ CMap (getVal val k) (zip nms cs)+                  +                  -- Only value+                  CType True _ _ -> return $ CValue (keyStateVar s k)++                  _ -> error "Unknown configuration type"++          getVal val k = if val then Just (keyStateVar s k) else Nothing++          goMap len k = do+              let offsets = take (fromIntegral len) [0..]+              nms <- mapM (configurationMapSubkeyName s k) offsets+              cs  <- mapM (go <=< configurationMapAt s k) nms+              return (nms, cs, offsets)++keyStateVar :: Configuration s -> CKey -> StateVar Text+keyStateVar c k = makeStateVar getV setV+    where getV = configurationValueGet c k+          setV = configurationValueSet c k++instance AMVTree ConfTree where+    atArray i (CArray _ a) = lookup i a+    atArray i (CBoth _ xs) = lookup i . map (first snd) $ xs+    atArray _ _ = Nothing++    atMap i (CMap _ m) = lookup i m+    atMap i (CBoth _ xs) = lookup i . map (first fst) $ xs+    atMap _ _ = Nothing++    value (CValue v) = Just v+    value (CArray (Just v) _) = Just v+    value (CBoth (Just v) _) = Just v+    value (CMap (Just v) _) = Just v+    value _ = Nothing++-- | Get a configuration option from the tree. If any lookup fails, the result+-- will be 'Nothing'. The tree will be traversed lazily, but the result is+-- evaluated before returning!+fromConfig :: Configuration s +           -> (ConfTree (StateVar Text) -> Maybe w) +           -> Clingo s (Maybe w)+fromConfig s f = head <$> fromConfigMany s [f]++-- | Like 'fromConfig' but supporting multiple paths.+fromConfigMany :: Configuration s +               -> [ConfTree (StateVar Text) -> Maybe w] +               -> Clingo s [Maybe w]+fromConfigMany s fs = getTree s >>= \t -> return (force fs <*> [t])
+ src/Clingo/Control.hs view
@@ -0,0 +1,346 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternSynonyms #-}+module Clingo.Control+(+    IOSym,+    Clingo,+    ClingoWarning,+    warningString,+    ClingoSetting (..),+    defaultClingo,+    withDefaultClingo,+    withClingo,+    +    Part (..),++    loadProgram,+    addProgram,+    ground,+    interrupt,+    cleanup,+    registerPropagator,+    registerUnsafePropagator,+    Continue (..),+    SymbolicLiteral (..),+    SolveResult (..),+    exhausted,+    Solver,+    solve,+    withSolver,+    SolveMode,+    pattern SolveModeAsync,+    pattern SolveModeYield,++    statistics,+    programBuilder,+    configuration,+    backend,+    symbolicAtoms,+    theoryAtoms,++    TruthValue,+    pattern TruthTrue,+    pattern TruthFalse,+    pattern TruthFree,+    negateTruth,+    assignExternal,+    releaseExternal,+    getConst,+    hasConst,+    useEnumAssumption,++    version+)+where++import Control.Monad.IO.Class+import Control.Monad.Trans+import Control.Monad.Catch+import Data.Text (Text, pack, unpack)+import Data.Foldable++import Foreign+import Foreign.C++import Numeric.Natural++import qualified Clingo.Raw as Raw+import Clingo.Internal.Utils+import Clingo.Internal.Symbol+import Clingo.Internal.Types+import Clingo.Solving (solverClose)+import Clingo.Propagation (Propagator, propagatorToIO)++-- | Data type to encapsulate the settings for clingo.+data ClingoSetting = ClingoSetting+    { clingoArgs   :: [String]+    , clingoLogger :: Maybe (ClingoWarning -> Text -> IO ())+    , msgLimit     :: Natural }++-- | Default settings for clingo. This is like calling clingo with no arguments,+-- and no logger.+defaultClingo :: ClingoSetting+defaultClingo = ClingoSetting [] Nothing 0++-- | The entry point into a computation utilizing clingo. Inside, a handle to+-- the clingo solver is available, which can not leave scope. By the same+-- mechanism, derived handles cannot be passed out either.+withClingo :: ClingoSetting -> (forall s. Clingo s r) -> IO r+withClingo settings action = do+    let argc = length (clingoArgs settings)+    argv <- liftIO $ mapM newCString (clingoArgs settings)+    ctrl <- marshall1 $ \x ->+        withArray argv $ \argvArr -> do+            logCB <- maybe (pure nullFunPtr) wrapCBLogger +                         (clingoLogger settings)+            let argv' = case clingoArgs settings of+                            [] -> nullPtr+                            _  -> argvArr+            Raw.controlNew argv' (fromIntegral argc)+                           logCB nullPtr (fromIntegral . msgLimit $ settings) x+    finally (runClingo ctrl action) $ do+        Raw.controlFree ctrl+        liftIO $ mapM_ free argv++-- | Equal to @withClingo defaultClingo@+withDefaultClingo :: (forall s. Clingo s r) -> IO r+withDefaultClingo = withClingo defaultClingo++-- | Load a logic program from a file.+loadProgram :: FilePath -> Clingo s ()+loadProgram path = askC >>= \ctrl ->+    marshall0 (withCString path (Raw.controlLoad ctrl))++-- | Add an ungrounded logic program to the solver as a 'Text'. This function+-- can be used in order to utilize clingo's parser. See 'parseProgram' for when+-- you want to modify the AST before adding it.+addProgram :: Foldable t+           => Text                      -- ^ Part Name+           -> t Text                    -- ^ Part Arguments+           -> Text                      -- ^ Program Code+           -> Clingo s ()+addProgram name params code = askC >>= \ctrl -> marshall0 $ +    withCString (unpack name) $ \n ->+        withCString (unpack code) $ \c -> do+            ptrs <- mapM (newCString . unpack) (toList params)+            withArrayLen ptrs $ \s ps ->+                Raw.controlAdd ctrl n ps (fromIntegral s) c++-- | A 'Part' is one building block of a logic program in clingo. Parts can be+-- grounded separately and can have arguments, which need to be initialized with+-- the solver.+data Part s = Part+    { partName   :: Text+    , partParams :: [Symbol s] }++rawPart :: Part s -> IO Raw.Part+rawPart p = Raw.Part <$> newCString (unpack (partName p))+                     <*> newArray (map rawSymbol . partParams $ p)+                     <*> pure (fromIntegral (length . partParams $ p))++freeRawPart :: Raw.Part -> IO ()+freeRawPart p = do+    free (Raw.partName p)+    free (Raw.partParams p)++-- | Ground logic program parts. A callback can be provided to inject symbols+-- when needed.+ground :: [Part s]      -- ^ Parts to be grounded+       -> Maybe +          (Location -> Text -> [Symbol s] -> ([Symbol s] -> IO ()) -> IO ())+                        -- ^ Callback for injecting symbols+       -> Clingo s ()+ground parts extFun = askC >>= \ctrl -> marshall0 $ do+    rparts <- mapM rawPart parts+    res <- withArrayLen rparts $ \len arr -> do+        groundCB <- maybe (pure nullFunPtr) wrapCBGround extFun+        Raw.controlGround ctrl arr (fromIntegral len) groundCB nullPtr+    mapM_ freeRawPart rparts+    return res++wrapCBGround :: MonadIO m+             => (Location -> Text -> [Symbol s] +                          -> ([Symbol s] -> IO ()) -> IO ())+             -> m (FunPtr (Raw.CallbackGround ()))+wrapCBGround f = liftIO $ Raw.mkCallbackGround go+    where go :: Raw.CallbackGround ()+          go loc name arg args _ cbSym _ = reraiseIO $ do+              loc'  <- fromRawLocation =<< peek loc+              name' <- pack <$> peekCString name+              syms  <- mapM pureSymbol =<< peekArray (fromIntegral args) arg+              f loc' name' syms (unwrapCBSymbol $ Raw.getCallbackSymbol cbSym)++unwrapCBSymbol :: Raw.CallbackSymbol () -> ([Symbol s] -> IO ())+unwrapCBSymbol f syms =+    withArrayLen (map rawSymbol syms) $ \len arr -> +        marshall0 (f arr (fromIntegral len) nullPtr)++-- | Interrupt the current solve call.+interrupt :: Clingo s ()+interrupt = Raw.controlInterrupt =<< askC++-- | Clean up the domains of clingo's grounding component using the solving+-- component's top level assignment.+--+-- This function removes atoms from domains that are false and marks atoms as+-- facts that are true.  With multi-shot solving, this can result in smaller+-- groundings because less rules have to be instantiated and more+-- simplifications can be applied.+cleanup :: Clingo s ()+cleanup = marshall0 . Raw.controlCleanup =<< askC++-- | A datatype that can be used to indicate whether solving shall continue or+-- not.+data Continue = Continue | Stop+    deriving (Eq, Show, Ord, Read, Enum, Bounded)++continueBool :: Continue -> Bool+continueBool Continue = True+continueBool Stop = False++-- | Solve the currently grounded logic program enumerating its models. Takes an+-- optional event callback. Since Clingo 5.2, the callback is no longer the only+-- way to interact with models. The callback can still be used to obtain the+-- same functionality as before. It will be called with 'Nothing' when there is+-- no more model.+--+-- Furthermore, asynchronous solving and iterative solving is also controlled+-- from this function. See "Clingo.Solving" for more details.+--+-- The 'Solver' must be closed explicitly after use. See 'withSolver' for a+-- bracketed version.+solve :: SolveMode -> [SymbolicLiteral s]+      -> Maybe (Maybe (Model s) -> IOSym s Continue)+      -> Clingo s (Solver s)+solve mode assumptions onEvent = do+    ctrl <- askC+    Solver <$> marshall1 (go ctrl)+    where go ctrl x =+              withArrayLen (map rawSymLit assumptions) $ \len arr -> do+                  eventCB <- maybe (pure nullFunPtr) wrapCBEvent onEvent+                  Raw.controlSolve +                    ctrl (rawSolveMode mode) +                    arr (fromIntegral len) eventCB nullPtr +                    x++withSolver :: [SymbolicLiteral s] +    -> (forall s1. Solver s1 -> IOSym s1 r) +    -> Clingo s r+withSolver assumptions f = do+    x <- solve SolveModeYield assumptions Nothing+    Clingo (lift (f x)) +        `finally` solverClose x++wrapCBEvent :: MonadIO m+            => (Maybe (Model s) -> IOSym s Continue) +            -> m (FunPtr (Raw.CallbackEvent ()))+wrapCBEvent f = liftIO $ Raw.mkCallbackEvent go+    where go :: Raw.SolveEvent +             -> Ptr Raw.Model +             -> Ptr a +             -> Ptr Raw.CBool +             -> IO Raw.CBool+          go ev m _ r = reraiseIO $ do+              m' <- case ev of+                        Raw.SolveEventModel  -> Just . Model <$> peek m+                        Raw.SolveEventFinish -> pure Nothing+                        _ -> error "wrapCBEvent: Invalid solve event"+              poke r . fromBool. continueBool =<< iosym (f m')++-- | Obtain statistics handle. See 'Clingo.Statistics'.+statistics :: Clingo s (Statistics s)+statistics = fmap Statistics . marshall1 . Raw.controlStatistics =<< askC++-- | Obtain program builder handle. See 'Clingo.ProgramBuilding'.+programBuilder :: Clingo s (ProgramBuilder s)+programBuilder = fmap ProgramBuilder . marshall1 +               . Raw.controlProgramBuilder =<< askC++-- | Obtain backend handle. See 'Clingo.ProgramBuilding'.+backend :: Clingo s (Backend s)+backend = fmap Backend . marshall1 . Raw.controlBackend =<< askC++-- | Obtain configuration handle. See 'Clingo.Configuration'.+configuration :: Clingo s (Configuration s)+configuration = fmap Configuration . marshall1 +              . Raw.controlConfiguration =<< askC++-- | Obtain symbolic atoms handle. See 'Clingo.Inspection.SymbolicAtoms'.+symbolicAtoms :: Clingo s (SymbolicAtoms s)+symbolicAtoms = fmap SymbolicAtoms . marshall1 +              . Raw.controlSymbolicAtoms =<< askC++-- | Obtain theory atoms handle. See 'Clingo.Inspection.TheoryAtoms'.+theoryAtoms :: Clingo s (TheoryAtoms s)+theoryAtoms = fmap TheoryAtoms . marshall1 . Raw.controlTheoryAtoms =<< askC++-- | Configure how learnt constraints are handled during enumeration.+-- +-- If the enumeration assumption is enabled, then all information learnt from+-- the solver's various enumeration modes is removed after a solve call. This+-- includes enumeration of cautious or brave consequences, enumeration of+-- answer sets with or without projection, or finding optimal models, as well+-- as clauses added with clingo_solve_control_add_clause().+useEnumAssumption :: Bool -> Clingo s ()+useEnumAssumption b = askC >>= \ctrl -> +    marshall0 $ Raw.controlUseEnumAssumption ctrl (fromBool b)++-- | Assign a truth value to an external atom.+-- +-- If the atom does not exist or is not external, this is a noop.+assignExternal :: Symbol s -> TruthValue -> Clingo s ()+assignExternal s t = askC >>= \ctrl -> +    marshall0 $ Raw.controlAssignExternal ctrl (rawSymbol s) (rawTruthValue t)++-- | Release an external atom.+-- +-- After this call, an external atom is no longer external and subject to+-- program simplifications.  If the atom does not exist or is not external,+-- this is a noop.+releaseExternal :: Symbol s -> Clingo s ()+releaseExternal s = askC >>= \ctrl -> +    marshall0 $ Raw.controlReleaseExternal ctrl (rawSymbol s)++-- | Get the symbol for a constant definition @#const name = symbol@.+getConst :: Text -> Clingo s (Symbol s)+getConst name = askC >>= \ctrl -> pureSymbol =<< marshall1 (go ctrl)+    where go ctrl x = withCString (unpack name) $ \cstr -> +                          Raw.controlGetConst ctrl cstr x++-- | Check if there is a constant definition for the given constant.+hasConst :: Text -> Clingo s Bool+hasConst name = askC >>= \ctrl -> toBool <$> marshall1 (go ctrl)+    where go ctrl x = withCString (unpack name) $ \cstr ->+                          Raw.controlHasConst ctrl cstr x+++-- | Register a custom propagator with the solver.+--+-- If the sequential flag is set to true, the propagator is called+-- sequentially when solving with multiple threads.+-- +-- See the 'Clingo.Propagation' module for more information.+registerPropagator :: Bool -> Propagator s -> Clingo s ()+registerPropagator sequ prop = do+    ctrl <- askC+    prop' <- rawPropagator . propagatorToIO $ prop+    res <- liftIO $ with prop' $ \ptr ->+               Raw.controlRegisterPropagator ctrl ptr nullPtr (fromBool sequ)+    checkAndThrow res++-- | Like 'registerPropagator' but allows using 'IOPropagator's from+-- 'Clingo.Internal.Propagation'. This function is unsafe!+registerUnsafePropagator :: Bool -> IOPropagator s -> Clingo s ()+registerUnsafePropagator sequ prop = do+    ctrl <- askC+    prop' <- rawPropagator prop+    res <- liftIO $ with prop' $ \ptr ->+               Raw.controlRegisterPropagator ctrl ptr nullPtr (fromBool sequ)+    checkAndThrow res++-- | Get clingo version.+version :: MonadIO m => m (Int, Int, Int)+version = do +    (a,b,c) <- marshall3V Raw.version+    return (fromIntegral a, fromIntegral b, fromIntegral c)
+ src/Clingo/Inspection/Ground.hs view
@@ -0,0 +1,140 @@+module Clingo.Inspection.Ground+(+    TermId (..),+    ElementId (..),+    AspifStmt (..),+    registerGroundObserver+)+where++import Control.Monad.IO.Class+import Data.Text (Text, pack)++import Foreign+import Foreign.C+import Numeric.Natural++import Clingo.ProgramBuilding+import Clingo.Internal.Types+import Clingo.Internal.Utils++import qualified Clingo.Raw as Raw++newtype TermId = TermId { termId :: Raw.Identifier }+    deriving (Show, Eq, Ord)++newtype ElementId = ElementId { elementId :: Raw.Identifier }+    deriving (Show, Eq, Ord)++data AspifStmt s+    = GRule Bool [Atom s] [Literal s]+    | GWeightedRule Bool [Atom s] Natural [WeightedLiteral s]+    | GMinimize Natural [WeightedLiteral s]+    | GProject [Atom s]+    | GExternal (Atom s) ExternalType+    | GAssume [Literal s]+    | GHeuristic (Atom s) HeuristicType Integer Natural [Literal s]+    | GAcycEdge Node Node [Literal s]+    | GTheoryTermNumber TermId Integer+    | GTheoryTermString TermId Text+    | GTheoryTermTuple TermId [TermId]+    | GTheoryTermSet TermId [TermId]+    | GTheoryTermList TermId [TermId]+    | GTheoryTermFunction TermId TermId [TermId]+    | GTheoryElement ElementId [TermId] [Literal s]+    | GTheoryAtom (Maybe (Atom s)) TermId [ElementId]+    | GTheoryAtomGuard (Maybe (Atom s)) TermId [ElementId] TermId TermId++mkRawGPO :: MonadIO m+         => (Bool -> IOSym s ())+         -> (AspifStmt s -> IOSym s ())+         -> m (Raw.GroundProgramObserver ())+mkRawGPO inf k = liftIO $ Raw.GroundProgramObserver+    <$> Raw.mkGpoInitProgram (\b _ -> reraiseIO (iosym (inf (toBool b))))+    <*> pure nullFunPtr+    <*> pure nullFunPtr+    <*> Raw.mkGpoRule rul+    <*> Raw.mkGpoWeightRule wrule+    <*> Raw.mkGpoMinimize minim+    <*> Raw.mkGpoProject proj+    <*> Raw.mkGpoExternal exter+    <*> Raw.mkGpoAssume assum+    <*> Raw.mkGpoHeuristic heuristi+    <*> Raw.mkGpoAcycEdge acyc+    <*> Raw.mkGpoTheoryTermNum ttnum+    <*> Raw.mkGpoTheoryTermStr ttstr+    <*> Raw.mkGpoTheoryTermCmp ttcomp+    <*> Raw.mkGpoTheoryElement telem+    <*> Raw.mkGpoTheoryAtom tatom+    <*> Raw.mkGpoTheoryAtomGrd tatomg++    where rul b as an ls ln _ = reraiseIO $ do+              as' <- map Atom <$> peekArray (fromIntegral an) as+              ls' <- map Literal <$> peekArray (fromIntegral ln) ls+              iosym (k (GRule (toBool b) as' ls'))+          wrule b as an w ws wn _ = reraiseIO $ do+              as' <- map Atom <$> peekArray (fromIntegral an) as+              ws' <- map fromRawWeightedLiteral <$> +                        peekArray (fromIntegral wn) ws+              iosym (k (GWeightedRule (toBool b) as' (fromIntegral w) ws'))+          minim w ws wn _ = reraiseIO $ do+              ws' <- map fromRawWeightedLiteral <$>+                        peekArray (fromIntegral wn) ws+              iosym (k (GMinimize (fromIntegral w) ws'))+          proj as an _ = reraiseIO $ do+              as' <- map Atom <$> peekArray (fromIntegral an) as+              iosym (k (GProject as'))+          exter a t _ = reraiseIO $+              iosym (k (GExternal (Atom a) (fromRawExtT t)))+          assum ls n _ = reraiseIO $ do+              ls' <- map Literal <$> peekArray (fromIntegral n) ls+              iosym (k (GAssume ls'))+          heuristi a t c d ls n _ = reraiseIO $ do+              let a' = Atom a+                  t' = fromRawHeuT t+                  c' = fromIntegral c+                  d' = fromIntegral d+              ls' <- map Literal <$> peekArray (fromIntegral n) ls+              iosym (k (GHeuristic a' t' c' d' ls'))+          acyc a b ls n _ = reraiseIO $ do+              let a' = Node . fromIntegral $ a+                  b' = Node . fromIntegral $ b+              ls' <- map Literal <$> peekArray (fromIntegral n) ls+              iosym (k (GAcycEdge a' b' ls'))+          ttnum i x _ = reraiseIO $+              iosym (k (GTheoryTermNumber (TermId i) (fromIntegral x)))+          ttstr i t _ = reraiseIO $ do+              t' <- pack <$> peekCString t+              iosym (k (GTheoryTermString (TermId i) t'))+          ttcomp i a is n _ = reraiseIO $ do+              is' <- map TermId <$> peekArray (fromIntegral n) is+              case a of+                  (-1) -> iosym (k (GTheoryTermTuple (TermId i) is'))+                  (-2) -> iosym (k (GTheoryTermSet (TermId i) is'))+                  (-3) -> iosym (k (GTheoryTermList (TermId i) is'))+                  a'   -> iosym (k (GTheoryTermFunction (TermId i) +                                       (TermId (fromIntegral a')) is'))+          telem i is n ls ln _ = reraiseIO $ do+              is' <- map TermId <$> peekArray (fromIntegral n) is+              ls' <- map Literal <$> peekArray (fromIntegral ln) ls+              iosym (k (GTheoryElement (ElementId i) is' ls'))+          tatom i t es n = reraiseIO $ do+              let i' = if i == 0 then Nothing else Just (Atom (fromIntegral i))+                  t' = TermId t+              es' <- map ElementId <$> peekArray (fromIntegral n) es+              iosym (k (GTheoryAtom i' t' es'))+          tatomg i t es n a b _ = reraiseIO $ do+              let i' = if i == 0 then Nothing else Just (Atom (fromIntegral i))+                  t' = TermId t+                  a' = TermId a+                  b' = TermId b+              es' <- map ElementId <$> peekArray (fromIntegral n) es+              iosym (k (GTheoryAtomGuard i' t' es' a' b'))++registerGroundObserver :: (Bool -> IOSym s ()) +                       -> (AspifStmt s -> IOSym s ())+                       -> Clingo s ()+registerGroundObserver i k = do+    ctrl <- askC+    gpo  <- mkRawGPO i k+    marshall0 $ with gpo $ \ptr -> Raw.controlRegisterObserver ctrl ptr nullPtr
+ src/Clingo/Inspection/Symbolic.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveGeneric #-}+module Clingo.Inspection.Symbolic+(+    SymbolicAtoms,+    SymbolicAtom (..),+    AspifLiteral,+    fromSymbolicAtoms,+    fromSymbolicAtomsSig,+    S.symbolicAtomsSignatures+)+where++import Control.DeepSeq+import Control.Monad.IO.Class+import Control.Monad.Catch++import GHC.Generics++import Clingo.Internal.Types+import qualified Clingo.Internal.Inspection.Symbolic as S++import System.IO.Unsafe++data SymbolicAtom s = SymbolicAtom+    { external :: Bool+    , literal  :: AspifLiteral s+    , symbol   :: Symbol s+    , fact     :: Bool+    }+    deriving (Generic)++instance NFData (SymbolicAtom s)++fromSymbolicAtoms :: (MonadIO m, MonadThrow m, NFData a)+                  => SymbolicAtoms s +                  -> ([SymbolicAtom s] -> a) +                  -> m a+fromSymbolicAtoms s f = force . f <$> buildSAtoms Nothing s++fromSymbolicAtomsSig :: (MonadIO m, MonadThrow m, NFData a)+                     => SymbolicAtoms s+                     -> Signature s+                     -> ([SymbolicAtom s] -> a)+                     -> m a+fromSymbolicAtomsSig s sig f = force . f <$> buildSAtoms (Just sig) s++getSAtom :: (MonadIO m, MonadThrow m)+         => S.SymbolicAtoms s -> S.SIterator s -> m (SymbolicAtom s)+getSAtom s i = SymbolicAtom+           <$> S.symbolicAtomsIsExternal s i+           <*> S.symbolicAtomsLiteral s i+           <*> S.symbolicAtomsSymbol s i+           <*> S.symbolicAtomsIsFact s i++buildSAtoms :: (MonadIO m, MonadThrow m)+            => Maybe (Signature s) -> S.SymbolicAtoms s -> m [SymbolicAtom s]+buildSAtoms sig s = do+    start <- S.symbolicAtomsBegin s sig+    end   <- S.symbolicAtomsEnd s+    liftIO $ go end start+    where go end i = unsafeInterleaveIO $ do+              abort <- S.symbolicAtomsIteratorEq s end i+              if abort then return []+              else let next = S.symbolicAtomsNext s i+                    in (:) <$> getSAtom s i <*> (go end =<< next)
+ src/Clingo/Inspection/Theory.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveGeneric #-}+module Clingo.Inspection.Theory+(+    TheoryAtoms,+    AspifLiteral,++    Guard (..),+    Element (..),+    GroundTheoryAtom (..),+    GroundTheoryTerm (..),+    renderTerm,+    termName,++    fromTheoryAtoms+)+where++import Control.DeepSeq+import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Maybe++import Data.Text (Text)+import GHC.Generics++import qualified Clingo.Internal.Inspection.Theory as I+import Clingo.Internal.Types++import System.IO.Unsafe++data Guard s = Guard Text (GroundTheoryTerm s)+    deriving (Generic)++instance NFData (Guard s)++data Element s = Element+    { elementTuple       :: [GroundTheoryTerm s]+    , elementCondition   :: [AspifLiteral s]+    , elementConditionId :: AspifLiteral s+    , renderElement      :: Text+    }+    deriving (Generic)++instance NFData (Element s)++data GroundTheoryAtom s = GroundTheoryAtom +    { atomGuard    :: Maybe (Guard s)+    , atomTerm     :: GroundTheoryTerm s+    , atomElements :: [Element s]+    , atomLiteral  :: AspifLiteral s+    , renderAtom   :: Text+    }+    deriving (Generic)++instance NFData (GroundTheoryAtom s)++data GroundTheoryTerm s+    = SymbolTerm Text Text+    | FunctionTerm Text Text [GroundTheoryTerm s]+    | NumberTerm Text Integer+    | TupleTerm Text [Element s]+    | ListTerm Text [Element s]+    | SetTerm Text [Element s]+    deriving (Generic)++instance NFData (GroundTheoryTerm s)++renderTerm :: GroundTheoryTerm s -> Text+renderTerm (SymbolTerm r _) = r+renderTerm (FunctionTerm r _ _) = r+renderTerm (NumberTerm r _) = r+renderTerm (TupleTerm r _) = r+renderTerm (ListTerm r _) = r+renderTerm (SetTerm r _) = r++termName :: GroundTheoryTerm s -> Maybe Text+termName (SymbolTerm _ n) = Just n+termName (FunctionTerm _ n _) = Just n+termName _ = Nothing++fromTheoryAtoms :: (MonadIO m, MonadThrow m, NFData w)+                => TheoryAtoms s -> ([GroundTheoryAtom s] -> w) -> m w+fromTheoryAtoms t f = do+    size <- I.theoryAtomsSize t+    ids  <- mapM (I.theoryAtomsId t) (take (fromIntegral size) [0..])+    atoms <- mapM (buildAtom t) (catMaybes ids)+    return . force $ f atoms++buildTerm :: MonadIO m+          => TheoryAtoms s -> I.TermId -> m (GroundTheoryTerm s)+buildTerm t i = liftIO . unsafeInterleaveIO $ do+    typ <- I.theoryAtomsTermType t i+    case typ of+        I.TheorySymbol -> SymbolTerm+            <$> I.theoryAtomsTermToString t i+            <*> I.theoryAtomsTermName t i+        I.TheoryFunction -> FunctionTerm+            <$> I.theoryAtomsTermToString t i+            <*> I.theoryAtomsTermName t i+            <*> (mapM (buildTerm t) =<< I.theoryAtomsTermArguments t i)+        I.TheoryNumber -> NumberTerm+            <$> I.theoryAtomsTermToString t i+            <*> I.theoryAtomsTermNumber t i+        I.TheoryList -> ListTerm+            <$> I.theoryAtomsTermToString t i+            <*> pure []+        I.TheorySet -> SetTerm+            <$> I.theoryAtomsTermToString t i+            <*> pure []+        I.TheoryTuple -> TupleTerm+            <$> I.theoryAtomsTermToString t i+            <*> pure []+        _ -> error "Invalid theory term type"++buildElement :: MonadIO m+             => TheoryAtoms s -> I.ElementId -> m (Element s)+buildElement t i = liftIO . unsafeInterleaveIO $ Element +    <$> (mapM (buildTerm t) =<< I.theoryAtomsElementTuple t i)+    <*> I.theoryAtomsElementCondition t i+    <*> I.theoryAtomsElementConditionId t i+    <*> I.theoryAtomsElementToString t i++buildAtom :: MonadIO m+          => TheoryAtoms s -> I.AtomId -> m (GroundTheoryAtom s)+buildAtom t i = liftIO . unsafeInterleaveIO $ GroundTheoryAtom+    <$> buildGuard+    <*> (buildTerm t =<< I.theoryAtomsAtomTerm t i)+    <*> (mapM (buildElement t) =<< I.theoryAtomsAtomElements t i)+    <*> I.theoryAtomsAtomLiteral t i+    <*> I.theoryAtomsAtomToString t i++    where buildGuard = do+              b <- I.theoryAtomsAtomHasGuard t i+              if b +                  then do+                       (x, tid) <- I.theoryAtomsAtomGuard t i+                       term <- buildTerm t tid+                       return $ Just (Guard x term)+                  else return Nothing
+ src/Clingo/Internal/AST.hs view
@@ -0,0 +1,1690 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+module Clingo.Internal.AST where++import Control.Monad+import Data.Text (Text, unpack, pack)+import Data.Text.Lazy (fromStrict)+import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Numeric.Natural+import Foreign hiding (Pool, freePool)+import Foreign.C++import Text.PrettyPrint.Leijen.Text hiding ((<$>))++import Clingo.Internal.Types (Location, rawLocation, freeRawLocation, +                              fromRawLocation, Symbol (..), Signature (..))+import Clingo.Internal.Symbol (pureSymbol, pureSignature)+import Clingo.Raw.AST++newArray' :: Storable a => [a] -> IO (Ptr a)+newArray' [] = pure nullPtr+newArray' xs = newArray xs++freeArray :: Storable a => Ptr a -> CSize -> (a -> IO ()) -> IO ()+freeArray p n f = unless (p == nullPtr) $ do+    p' <- peekArray (fromIntegral n) p+    mapM_ f p'+    free p++freeIndirection :: Storable a => Ptr a -> (a -> IO ()) -> IO ()+freeIndirection p f = unless (p == nullPtr) $ do+    p' <- peek p+    f p'+    free p++peekMaybe :: Storable a => Ptr a -> IO (Maybe a)+peekMaybe p+    | p == nullPtr = return Nothing+    | otherwise    = Just <$> peek p++fromIndirect :: Storable a => Ptr a -> (a -> IO b) -> IO b+fromIndirect p f = peek p >>= f++data Sign = NoSign | NegationSign | DoubleNegationSign+    deriving (Eq, Show, Ord)++instance Pretty Sign where+    pretty NoSign = empty+    pretty NegationSign = text "not"+    pretty DoubleNegationSign = text "not not"++rawSign :: Sign -> AstSign+rawSign s = case s of+    NoSign -> AstSignNone+    NegationSign -> AstSignNegation+    DoubleNegationSign -> AstSignDoubleNegation++fromRawSign :: AstSign -> Sign+fromRawSign s = case s of+    AstSignNone -> NoSign+    AstSignNegation -> NegationSign+    AstSignDoubleNegation -> DoubleNegationSign+    _ -> error "Invalid clingo_ast_sign_t"++data UnaryOperation a = UnaryOperation UnaryOperator (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (UnaryOperation a) where+    pretty (UnaryOperation o t) = pretty o <+> pretty t++rawUnaryOperation :: UnaryOperation (Symbol s) -> IO AstUnaryOperation+rawUnaryOperation (UnaryOperation o t) = +    AstUnaryOperation <$> pure (rawUnaryOperator o) <*> rawTerm t++freeUnaryOperation :: AstUnaryOperation -> IO ()+freeUnaryOperation (AstUnaryOperation _ t) = freeTerm t++fromRawUnaryOperation :: AstUnaryOperation -> IO (UnaryOperation (Symbol s))+fromRawUnaryOperation (AstUnaryOperation o t) = UnaryOperation+    <$> pure (fromRawUnaryOperator o)+    <*> fromRawTerm t++data UnaryOperator = UnaryMinus | Negation | Absolute+    deriving (Eq, Show, Ord)++instance Pretty UnaryOperator where+    pretty UnaryMinus = text "-"+    pretty _ = text "<unaryOp>"         -- TODO++rawUnaryOperator :: UnaryOperator -> AstUnaryOperator+rawUnaryOperator o = case o of+    UnaryMinus -> AstUnaryOperatorMinus+    Negation -> AstUnaryOperatorNegation+    Absolute -> AstUnaryOperatorAbsolute++fromRawUnaryOperator :: AstUnaryOperator -> UnaryOperator+fromRawUnaryOperator o = case o of+    AstUnaryOperatorMinus -> UnaryMinus+    AstUnaryOperatorNegation -> Negation+    AstUnaryOperatorAbsolute -> Absolute+    _ -> error "Invalid clingo_ast_unary_operator_t"++data BinaryOperation a = BinaryOperation BinaryOperator (Term a) (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (BinaryOperation a) where+    pretty (BinaryOperation o a b) = pretty a <+> pretty o <+> pretty b++rawBinaryOperation :: BinaryOperation (Symbol s) -> IO AstBinaryOperation+rawBinaryOperation (BinaryOperation o l r) =+    AstBinaryOperation <$> pure (rawBinaryOperator o) +                       <*> rawTerm l <*> rawTerm r++freeBinaryOperation :: AstBinaryOperation -> IO ()+freeBinaryOperation (AstBinaryOperation _ a b) = freeTerm a >> freeTerm b++fromRawBinaryOperation :: AstBinaryOperation -> IO (BinaryOperation (Symbol s))+fromRawBinaryOperation (AstBinaryOperation o a b) = BinaryOperation+    <$> pure (fromRawBinaryOperator o) <*> fromRawTerm a <*> fromRawTerm b++data BinaryOperator = Xor | Or | And | Plus | Minus | Mult | Div | Mod+    deriving (Eq, Show, Ord)++instance Pretty BinaryOperator where+    pretty o = text $ case o of+        Xor -> "^"+        Or -> "|"+        And -> "&"+        Plus -> "+"+        Minus -> "-"+        Mult -> "*"+        Div -> "/"+        Mod -> "%"++rawBinaryOperator :: BinaryOperator -> AstBinaryOperator+rawBinaryOperator o = case o of+    Xor -> AstBinaryOperatorXor+    Or -> AstBinaryOperatorOr+    And -> AstBinaryOperatorAnd+    Plus -> AstBinaryOperatorPlus+    Minus -> AstBinaryOperatorMinus+    Mult -> AstBinaryOperatorMultiplication+    Div -> AstBinaryOperatorDivision+    Mod -> AstBinaryOperatorModulo++fromRawBinaryOperator :: AstBinaryOperator -> BinaryOperator+fromRawBinaryOperator o = case o of+    AstBinaryOperatorXor -> Xor +    AstBinaryOperatorOr -> Or +    AstBinaryOperatorAnd -> And +    AstBinaryOperatorPlus -> Plus +    AstBinaryOperatorMinus -> Minus +    AstBinaryOperatorMultiplication -> Mult +    AstBinaryOperatorDivision -> Div +    AstBinaryOperatorModulo -> Mod +    _ -> error "Invalid clingo_ast_binary_operator_t"++data Interval a = Interval (Term a) (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Interval a) where+    pretty (Interval a b) = pretty a <> text ".." <> pretty b++rawInterval :: Interval (Symbol s) -> IO AstInterval+rawInterval (Interval a b) = AstInterval <$> rawTerm a <*> rawTerm b++freeInterval :: AstInterval -> IO ()+freeInterval (AstInterval a b) = freeTerm a >> freeTerm b++fromRawInterval :: AstInterval -> IO (Interval (Symbol s))+fromRawInterval (AstInterval a b) = Interval <$> fromRawTerm a <*> fromRawTerm b++data Function a = Function Text [Term a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Function a) where+    pretty (Function t []) = text . fromStrict $ t+    pretty (Function t xs) = (text . fromStrict $ t) <> tupled (map pretty xs)++rawFunction :: Function (Symbol s) -> IO AstFunction+rawFunction (Function n ts) = do+    n'  <- newCString (unpack n)+    ts' <- newArray' =<< mapM rawTerm ts+    return $ AstFunction n' ts' (fromIntegral . length $ ts)++freeFunction :: AstFunction -> IO ()+freeFunction (AstFunction s ts n) = do+    free s +    freeArray ts n freeTerm++fromRawFunction :: AstFunction -> IO (Function (Symbol s))+fromRawFunction (AstFunction s ts n) = Function+    <$> fmap pack (peekCString s)+    <*> (mapM fromRawTerm =<< peekArray (fromIntegral n) ts)++data Pool a = Pool [Term a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Pool a) where+    pretty (Pool _) = text "<pool>"  -- TODO!++rawPool :: Pool (Symbol s) -> IO AstPool+rawPool (Pool ts) = do+    ts' <- newArray' =<< mapM rawTerm ts+    return $ AstPool ts' (fromIntegral . length $ ts)++freePool :: AstPool -> IO ()+freePool (AstPool ts n) = freeArray ts n freeTerm++fromRawPool :: AstPool -> IO (Pool (Symbol s))+fromRawPool (AstPool ts n) = Pool+    <$> (mapM fromRawTerm =<< peekArray (fromIntegral n) ts)++data Term a+    = TermSymbol Location a+    | TermVariable Location Text+    | TermUOp Location (UnaryOperation a)+    | TermBOp Location (BinaryOperation a)+    | TermInterval Location (Interval a)+    | TermFunction Location (Function a)+    | TermExtFunction Location (Function a)+    | TermPool Location (Pool a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Term a) where+    pretty (TermSymbol _ a) = pretty a+    pretty (TermVariable _ t) = text . fromStrict $ t+    pretty (TermUOp _ o) = pretty o+    pretty (TermBOp _ o) = pretty o+    pretty (TermInterval _ i) = pretty i+    pretty (TermFunction _ f) = pretty f+    pretty (TermExtFunction _ f) = pretty f+    pretty (TermPool _ p) = pretty p++rawTerm :: Term (Symbol s) -> IO AstTerm+rawTerm (TermSymbol l s) = AstTermSymbol <$> rawLocation l +                                         <*> pure (rawSymbol s)+rawTerm (TermVariable l n) = AstTermVariable <$> rawLocation l +                                             <*> newCString (unpack n)+rawTerm (TermUOp l u) = AstTermUOp <$> rawLocation l +                                   <*> (new =<< rawUnaryOperation u)+rawTerm (TermBOp l u) = AstTermBOp <$> rawLocation l +                                   <*> (new =<< rawBinaryOperation u)+rawTerm (TermInterval l i) = AstTermInterval <$> rawLocation l +                                             <*> (new =<< rawInterval i)+rawTerm (TermFunction l f) = AstTermFunction <$> rawLocation l +                                             <*> (new =<< rawFunction f)+rawTerm (TermExtFunction l f) =+    AstTermExtFunction <$> rawLocation l +                       <*> (new =<< rawFunction f)+rawTerm (TermPool l p) = AstTermPool <$> rawLocation l +                                     <*> (new =<< rawPool p)++freeTerm :: AstTerm -> IO ()+freeTerm (AstTermSymbol l _) = freeRawLocation l+freeTerm (AstTermVariable l _) = freeRawLocation l+freeTerm (AstTermUOp l o) = +    freeRawLocation l >> freeIndirection o freeUnaryOperation+freeTerm (AstTermBOp l o) = +    freeRawLocation l >> freeIndirection o freeBinaryOperation+freeTerm (AstTermInterval l i) = +    freeRawLocation l >> freeIndirection i freeInterval+freeTerm (AstTermFunction l f) = +    freeRawLocation l >> freeIndirection f freeFunction+freeTerm (AstTermExtFunction l f) = +    freeRawLocation l >> freeIndirection f freeFunction+freeTerm (AstTermPool l p) = +    freeRawLocation l >> freeIndirection p freePool++fromRawTerm :: AstTerm -> IO (Term (Symbol s))+fromRawTerm (AstTermSymbol l s) = TermSymbol +    <$> fromRawLocation l <*> pureSymbol s+fromRawTerm (AstTermVariable l s) = TermVariable +    <$> fromRawLocation l <*> fmap pack (peekCString s)+fromRawTerm (AstTermUOp l o) = TermUOp +    <$> fromRawLocation l <*> fromIndirect o fromRawUnaryOperation+fromRawTerm (AstTermBOp l o) = TermBOp+    <$> fromRawLocation l <*> fromIndirect o fromRawBinaryOperation+fromRawTerm (AstTermInterval l i) = TermInterval+    <$> fromRawLocation l <*> fromIndirect i fromRawInterval+fromRawTerm (AstTermFunction l f) = TermFunction+    <$> fromRawLocation l <*> fromIndirect f fromRawFunction+fromRawTerm (AstTermExtFunction l f) = TermExtFunction+    <$> fromRawLocation l <*> fromIndirect f fromRawFunction+fromRawTerm (AstTermPool l p) = TermPool+    <$> fromRawLocation l <*> fromIndirect p fromRawPool++data CspProductTerm a = CspProductTerm Location (Term a) (Maybe (Term a))+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawCspProductTerm :: CspProductTerm (Symbol s) -> IO AstCspProductTerm+rawCspProductTerm (CspProductTerm l t m) = AstCspProductTerm+    <$> rawLocation l+    <*> rawTerm t+    <*> maybe (return nullPtr) (new <=< rawTerm) m++freeCspProductTerm :: AstCspProductTerm -> IO ()+freeCspProductTerm (AstCspProductTerm l t p) = do+    freeRawLocation l+    freeTerm t+    freeIndirection p freeTerm++fromRawCspProductTerm :: AstCspProductTerm -> IO (CspProductTerm (Symbol s))+fromRawCspProductTerm (AstCspProductTerm l t x) = CspProductTerm+    <$> fromRawLocation l+    <*> fromRawTerm t+    <*> (mapM fromRawTerm =<< peekMaybe x)++data CspSumTerm a = CspSumTerm Location [CspProductTerm a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawCspSumTerm :: CspSumTerm (Symbol s) -> IO AstCspSumTerm+rawCspSumTerm (CspSumTerm l ts) = do+    l' <- rawLocation l+    ts' <- newArray' =<< mapM rawCspProductTerm ts+    return $ AstCspSumTerm l' ts' (fromIntegral . length $ ts)++freeCspSumTerm :: AstCspSumTerm -> IO ()+freeCspSumTerm (AstCspSumTerm l ts n) = do+    freeRawLocation l+    freeArray ts n freeCspProductTerm++fromRawCspSumTerm :: AstCspSumTerm -> IO (CspSumTerm (Symbol s))+fromRawCspSumTerm (AstCspSumTerm l ts n) = CspSumTerm+    <$> fromRawLocation l+    <*> (mapM fromRawCspProductTerm =<< peekArray (fromIntegral n) ts)++data CspGuard a = CspGuard ComparisonOperator (CspSumTerm a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawCspGuard :: CspGuard (Symbol s) -> IO AstCspGuard+rawCspGuard (CspGuard o t) = AstCspGuard+    <$> pure (rawComparisonOperator o) <*> rawCspSumTerm t++freeCspGuard :: AstCspGuard -> IO ()+freeCspGuard (AstCspGuard _ t) = freeCspSumTerm t++fromRawCspGuard :: AstCspGuard -> IO (CspGuard (Symbol s))+fromRawCspGuard (AstCspGuard o t) = CspGuard+    <$> pure (fromRawComparisonOperator o)+    <*> fromRawCspSumTerm t++data ComparisonOperator = GreaterThan | LessThan | LessEqual | GreaterEqual+                        | NotEqual | Equal+    deriving (Eq, Show, Ord)++instance Pretty ComparisonOperator where+    pretty c = text $ case c of+        GreaterThan -> ">"+        LessThan -> "<"+        LessEqual -> "<="+        GreaterEqual -> ">="+        NotEqual -> "!="+        Equal -> "="++rawComparisonOperator :: ComparisonOperator -> AstComparisonOperator+rawComparisonOperator o = case o of+    GreaterThan -> AstComparisonOperatorGreaterThan+    LessThan -> AstComparisonOperatorLessThan+    LessEqual -> AstComparisonOperatorLessEqual+    GreaterEqual -> AstComparisonOperatorGreaterEqual+    NotEqual -> AstComparisonOperatorNotEqual+    Equal -> AstComparisonOperatorEqual++fromRawComparisonOperator :: AstComparisonOperator -> ComparisonOperator+fromRawComparisonOperator o = case o of+    AstComparisonOperatorGreaterThan -> GreaterThan+    AstComparisonOperatorLessThan -> LessThan+    AstComparisonOperatorLessEqual -> LessEqual+    AstComparisonOperatorGreaterEqual -> GreaterEqual+    AstComparisonOperatorNotEqual -> NotEqual+    AstComparisonOperatorEqual -> Equal+    _ -> error "Invalid clingo_ast_comparison_operator_type_t"++data CspLiteral a = CspLiteral (CspSumTerm a) [CspGuard a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawCspLiteral :: CspLiteral (Symbol s) -> IO AstCspLiteral+rawCspLiteral (CspLiteral t gs) = do+    gs' <- newArray' =<< mapM rawCspGuard gs+    t'  <- rawCspSumTerm t+    return $ AstCspLiteral t' gs' (fromIntegral . length $ gs)++freeCspLiteral :: AstCspLiteral -> IO ()+freeCspLiteral (AstCspLiteral t p n) = do+    freeCspSumTerm t+    freeArray p n freeCspGuard++fromRawCspLiteral :: AstCspLiteral -> IO (CspLiteral (Symbol s))+fromRawCspLiteral (AstCspLiteral t gs n) = CspLiteral+    <$> fromRawCspSumTerm t+    <*> (mapM fromRawCspGuard =<< peekArray (fromIntegral n) gs)++data Identifier = Identifier Location Text+    deriving (Eq, Show, Ord)++instance Pretty Identifier where+    pretty (Identifier _ t) = text . fromStrict $ t++rawIdentifier :: Identifier -> IO AstId+rawIdentifier (Identifier l t) = do+    l' <- rawLocation l+    t' <- newCString (unpack t)+    return $ AstId l' t'++freeIdentifier :: AstId -> IO ()+freeIdentifier (AstId l t) = freeRawLocation l >> free t++fromRawIdentifier :: AstId -> IO Identifier+fromRawIdentifier (AstId l n) = Identifier+    <$> fromRawLocation l+    <*> fmap pack (peekCString n)++data Comparison a = Comparison ComparisonOperator (Term a) (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Comparison a) where+    pretty (Comparison o a b) = pretty a <+> pretty o <+> pretty b++rawComparison :: Comparison (Symbol s) -> IO AstComparison+rawComparison (Comparison o a b) = AstComparison+    <$> pure (rawComparisonOperator o) <*> rawTerm a <*> rawTerm b++freeComparison :: AstComparison -> IO ()+freeComparison (AstComparison _ a b) = freeTerm a >> freeTerm b++fromRawComparison :: AstComparison -> IO (Comparison (Symbol s))+fromRawComparison (AstComparison o a b) = Comparison+    <$> pure (fromRawComparisonOperator o) <*> fromRawTerm a <*> fromRawTerm b++data Literal a+    = LiteralBool Location Sign Bool+    | LiteralTerm Location Sign (Term a)+    | LiteralComp Location Sign (Comparison a)+    | LiteralCSPL Location Sign (CspLiteral a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Literal a) where+    pretty (LiteralBool _ s b) = pretty s <+> if b then text "true" else empty+    pretty (LiteralTerm _ s t) = pretty s <+> pretty t+    pretty (LiteralComp _ s c) = pretty s <+> pretty c+    pretty _ = undefined -- TODO++rawLiteral :: Literal (Symbol s) -> IO AstLiteral+rawLiteral (LiteralBool l s b) = AstLiteralBool +    <$> rawLocation l <*> pure (rawSign s) <*> pure (fromBool b)+rawLiteral (LiteralTerm l s t) = AstLiteralTerm+    <$> rawLocation l <*> pure (rawSign s) <*> (new =<< rawTerm t)+rawLiteral (LiteralComp l s c) = AstLiteralComp+    <$> rawLocation l <*> pure (rawSign s) <*> (new =<< rawComparison c)+rawLiteral (LiteralCSPL l s x) = AstLiteralCSPL+    <$> rawLocation l <*> pure (rawSign s) <*> (new =<< rawCspLiteral x)++freeLiteral :: AstLiteral -> IO ()+freeLiteral (AstLiteralBool l _ _) = freeRawLocation l+freeLiteral (AstLiteralTerm l _ t) = +    freeRawLocation l >> freeIndirection t freeTerm+freeLiteral (AstLiteralComp l _ c) = +    freeRawLocation l >> freeIndirection c freeComparison+freeLiteral (AstLiteralCSPL l _ x) = +    freeRawLocation l >> freeIndirection x freeCspLiteral++fromRawLiteral :: AstLiteral -> IO (Literal (Symbol s))+fromRawLiteral (AstLiteralBool l s b) = LiteralBool +    <$> fromRawLocation l <*> pure (fromRawSign s) <*> pure (toBool b)+fromRawLiteral (AstLiteralTerm l s b) = LiteralTerm +    <$> fromRawLocation l <*> pure (fromRawSign s) +                          <*> fromIndirect b fromRawTerm+fromRawLiteral (AstLiteralComp l s b) = LiteralComp +    <$> fromRawLocation l <*> pure (fromRawSign s) +                          <*> fromIndirect b fromRawComparison+fromRawLiteral (AstLiteralCSPL l s b) = LiteralCSPL +    <$> fromRawLocation l <*> pure (fromRawSign s) +                          <*> fromIndirect b fromRawCspLiteral++data AggregateGuard a = AggregateGuard ComparisonOperator (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++-- | Instance describing left-guards.+instance Pretty a => Pretty (AggregateGuard a) where+    pretty (AggregateGuard o t) = pretty t <+> pretty o++aguardPRight :: Pretty a => AggregateGuard a -> Doc+aguardPRight (AggregateGuard o t) = pretty o <+> pretty t++aguardPLeft :: Pretty a => AggregateGuard a -> Doc+aguardPLeft = pretty++rawAggregateGuard :: AggregateGuard (Symbol s) -> IO AstAggregateGuard+rawAggregateGuard (AggregateGuard o t) = AstAggregateGuard+    <$> pure (rawComparisonOperator o) <*> rawTerm t++rawAggregateGuardM :: Maybe (AggregateGuard (Symbol s)) +                   -> IO (Ptr AstAggregateGuard)+rawAggregateGuardM Nothing = return nullPtr+rawAggregateGuardM (Just g) = new =<< rawAggregateGuard g++freeAggregateGuard :: AstAggregateGuard -> IO ()+freeAggregateGuard (AstAggregateGuard _ t) = freeTerm t++fromRawAggregateGuard :: AstAggregateGuard -> IO (AggregateGuard (Symbol s))+fromRawAggregateGuard (AstAggregateGuard o t) = AggregateGuard+    <$> pure (fromRawComparisonOperator o) <*> fromRawTerm t++data ConditionalLiteral a = ConditionalLiteral (Literal a) [Literal a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (ConditionalLiteral a) where+    pretty (ConditionalLiteral l []) = pretty l+    pretty (ConditionalLiteral l xs) = +        pretty l <+> colon <+> cat (punctuate (comma <> space) (map pretty xs))++rawConditionalLiteral :: ConditionalLiteral (Symbol s) +                      -> IO AstConditionalLiteral+rawConditionalLiteral (ConditionalLiteral l ls) = do+    l' <- rawLiteral l+    ls' <- newArray' =<< mapM rawLiteral ls+    return $ AstConditionalLiteral l' ls' (fromIntegral . length $ ls)++freeConditionalLiteral :: AstConditionalLiteral -> IO ()+freeConditionalLiteral (AstConditionalLiteral l ls n) = do+    freeLiteral l+    freeArray ls n freeLiteral++fromRawConditionalLiteral :: AstConditionalLiteral +                          -> IO (ConditionalLiteral (Symbol s))+fromRawConditionalLiteral (AstConditionalLiteral l ls n) = ConditionalLiteral+    <$> fromRawLiteral l +    <*> (mapM fromRawLiteral =<< peekArray (fromIntegral n) ls)++data Aggregate a = Aggregate [ConditionalLiteral a] +                             (Maybe (AggregateGuard a)) +                             (Maybe (AggregateGuard a))+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Aggregate a) where+    pretty (Aggregate xs l r) = +        pretty l <+> body <+> pretty (fmap aguardPRight r)+        where body = braces . align . cat $ +                         punctuate (semi <> space) (map pretty xs)++rawAggregate :: Aggregate (Symbol s) -> IO AstAggregate+rawAggregate (Aggregate ls a b) = do+    ls' <- newArray' =<< mapM rawConditionalLiteral ls+    a'  <- rawAggregateGuardM a+    b'  <- rawAggregateGuardM b+    return $ AstAggregate ls' (fromIntegral . length $ ls) a' b'++freeAggregate :: AstAggregate -> IO ()+freeAggregate (AstAggregate ls n a b) = do+    freeIndirection a freeAggregateGuard+    freeIndirection b freeAggregateGuard+    freeArray ls n freeConditionalLiteral++fromRawAggregate :: AstAggregate -> IO (Aggregate (Symbol s))+fromRawAggregate (AstAggregate ls n a b) = Aggregate+    <$> (mapM fromRawConditionalLiteral =<< peekArray (fromIntegral n) ls)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe a)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe b)++data BodyAggregateElement a = BodyAggregateElement [Term a] [Literal a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (BodyAggregateElement a) where+    pretty (BodyAggregateElement ts ls) =+        let ts' = map pretty ts+            ls' = map pretty ls+         in hcat (punctuate comma ts') <+> colon <+> hcat (punctuate comma ls')++rawBodyAggregateElement :: BodyAggregateElement (Symbol s) +                        -> IO AstBodyAggregateElement+rawBodyAggregateElement (BodyAggregateElement ts ls) = do+    ts' <- newArray' =<< mapM rawTerm ts+    ls' <- newArray' =<< mapM rawLiteral ls+    return $ AstBodyAggregateElement ts' (fromIntegral . length $ ts) +                                     ls' (fromIntegral . length $ ls)++freeBodyAggregateElement :: AstBodyAggregateElement -> IO ()+freeBodyAggregateElement (AstBodyAggregateElement ts nt ls nl) = do+    freeArray ts nt freeTerm+    freeArray ls nl freeLiteral++fromRawBodyAggregateElement :: AstBodyAggregateElement +                            -> IO (BodyAggregateElement (Symbol s))+fromRawBodyAggregateElement (AstBodyAggregateElement ts nt ls nl) = +    BodyAggregateElement+    <$> (mapM fromRawTerm =<< peekArray (fromIntegral nt) ts)+    <*> (mapM fromRawLiteral =<< peekArray (fromIntegral nl) ls)++data BodyAggregate a = BodyAggregate AggregateFunction [BodyAggregateElement a] +                                   (Maybe (AggregateGuard a))+                                   (Maybe (AggregateGuard a))+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (BodyAggregate a) where+    pretty (BodyAggregate f xs l r) =+        pretty f <+> pretty l <+> body <+> pretty (fmap aguardPRight r)+        where body = braces . align . cat $ punctuate semi (map pretty xs)++rawBodyAggregate :: BodyAggregate (Symbol s) -> IO AstBodyAggregate+rawBodyAggregate (BodyAggregate f es a b) = AstBodyAggregate+    <$> pure (rawAggregateFunction f)+    <*> (newArray' =<< mapM rawBodyAggregateElement es)+    <*> pure (fromIntegral . length $ es)+    <*> rawAggregateGuardM a+    <*> rawAggregateGuardM b++freeBodyAggregate :: AstBodyAggregate -> IO ()+freeBodyAggregate (AstBodyAggregate _ es n a b) = do+    freeArray es n freeBodyAggregateElement+    freeIndirection a freeAggregateGuard+    freeIndirection b freeAggregateGuard++fromRawBodyAggregate :: AstBodyAggregate -> IO (BodyAggregate (Symbol s))+fromRawBodyAggregate (AstBodyAggregate f es n a b) = BodyAggregate+    <$> pure (fromRawAggregateFunction f)+    <*> (mapM fromRawBodyAggregateElement =<< peekArray (fromIntegral n) es)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe a)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe b)++data AggregateFunction = Count | Sum | Sump | Min | Max+    deriving (Eq, Show, Ord)++instance Pretty AggregateFunction where+    pretty c = text $ case c of+        Count -> "#count"+        Sum -> "#sum"+        Sump -> "#sump"+        Min -> "#min"+        Max -> "#max"++rawAggregateFunction :: AggregateFunction -> AstAggregateFunction+rawAggregateFunction f = case f of+    Count -> AstAggregateFunctionCount+    Sum -> AstAggregateFunctionSum+    Sump -> AstAggregateFunctionSump+    Min -> AstAggregateFunctionMin+    Max -> AstAggregateFunctionMax++fromRawAggregateFunction :: AstAggregateFunction -> AggregateFunction+fromRawAggregateFunction f = case f of+    AstAggregateFunctionCount -> Count+    AstAggregateFunctionSum -> Sum+    AstAggregateFunctionSump -> Sump+    AstAggregateFunctionMin -> Min+    AstAggregateFunctionMax -> Max+    _ -> error "Invalid clingo_ast_aggregate_function_t"++data HeadAggregateElement a = +    HeadAggregateElement [Term a] (ConditionalLiteral a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (HeadAggregateElement a) where+    pretty (HeadAggregateElement ts l) =+        let ts' = map pretty ts+         in hcat (punctuate comma ts') <+> colon <+> pretty l++rawHeadAggregateElement :: HeadAggregateElement (Symbol s) +                        -> IO AstHeadAggregateElement+rawHeadAggregateElement (HeadAggregateElement ts l) = AstHeadAggregateElement+    <$> (newArray' =<< mapM rawTerm ts)+    <*> pure (fromIntegral . length $ ts)+    <*> rawConditionalLiteral l++freeHeadAggregateElement :: AstHeadAggregateElement -> IO ()+freeHeadAggregateElement (AstHeadAggregateElement p n l) = do+    freeArray p n freeTerm+    freeConditionalLiteral l++fromRawHeadAggregateElement :: AstHeadAggregateElement +                            -> IO (HeadAggregateElement (Symbol s))+fromRawHeadAggregateElement (AstHeadAggregateElement ts n l) = +    HeadAggregateElement+    <$> (mapM fromRawTerm =<< peekArray (fromIntegral n) ts)+    <*> fromRawConditionalLiteral l++data HeadAggregate a = HeadAggregate AggregateFunction+                                   [HeadAggregateElement a]+                                   (Maybe (AggregateGuard a))+                                   (Maybe (AggregateGuard a))+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (HeadAggregate a) where+    pretty (HeadAggregate f xs l r) =+        pretty f <+> pretty l <+> body <+> pretty (fmap aguardPRight r)+        where body = braces . align . sep $ punctuate semi (map pretty xs)++rawHeadAggregate :: HeadAggregate (Symbol s) -> IO AstHeadAggregate+rawHeadAggregate (HeadAggregate f es a b) = AstHeadAggregate+    <$> pure (rawAggregateFunction f)+    <*> (newArray' =<< mapM rawHeadAggregateElement es)+    <*> pure (fromIntegral . length $ es)+    <*> rawAggregateGuardM a+    <*> rawAggregateGuardM b++freeHeadAggregate :: AstHeadAggregate -> IO ()+freeHeadAggregate (AstHeadAggregate _ es n a b) = do+    freeArray es n freeHeadAggregateElement+    freeIndirection a freeAggregateGuard+    freeIndirection b freeAggregateGuard++fromRawHeadAggregate :: AstHeadAggregate -> IO (HeadAggregate (Symbol s))+fromRawHeadAggregate (AstHeadAggregate f es n a b) = HeadAggregate+    <$> pure (fromRawAggregateFunction f)+    <*> (mapM fromRawHeadAggregateElement =<< peekArray (fromIntegral n) es)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe a)+    <*> (mapM fromRawAggregateGuard =<< peekMaybe b)++data Disjunction a = Disjunction [ConditionalLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Disjunction a) where+    pretty (Disjunction xs) = hcat (punctuate (char '|') $ map pretty xs)++rawDisjunction :: Disjunction (Symbol s) -> IO AstDisjunction+rawDisjunction (Disjunction ls) = AstDisjunction +    <$> (newArray' =<< mapM rawConditionalLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeDisjunction :: AstDisjunction -> IO ()+freeDisjunction (AstDisjunction ls n) = freeArray ls n freeConditionalLiteral++fromRawDisjunction :: AstDisjunction -> IO (Disjunction (Symbol s))+fromRawDisjunction (AstDisjunction ls n) = Disjunction+    <$> (mapM fromRawConditionalLiteral =<< peekArray (fromIntegral n) ls)++data DisjointElement a = +    DisjointElement Location [Term a] (CspSumTerm a) [Literal a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawDisjointElement :: DisjointElement (Symbol s) -> IO AstDisjointElement+rawDisjointElement (DisjointElement l ts s ls) = AstDisjointElement+    <$> rawLocation l+    <*> (newArray' =<< mapM rawTerm ts)+    <*> pure (fromIntegral . length $ ts)+    <*> rawCspSumTerm s+    <*> (newArray' =<< mapM rawLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeDisjointElement :: AstDisjointElement -> IO ()+freeDisjointElement (AstDisjointElement l ts nt s ls nl) = do+    freeRawLocation l+    freeCspSumTerm s+    freeArray ts nt freeTerm+    freeArray ls nl freeLiteral++fromRawDisjointElement :: AstDisjointElement -> IO (DisjointElement (Symbol s))+fromRawDisjointElement (AstDisjointElement l ts nt s ls nl) = DisjointElement+    <$> fromRawLocation l+    <*> (mapM fromRawTerm =<< peekArray (fromIntegral nt) ts)+    <*> fromRawCspSumTerm s+    <*> (mapM fromRawLiteral =<< peekArray (fromIntegral nl) ls)++data Disjoint a = Disjoint [DisjointElement a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawDisjoint :: Disjoint (Symbol s) -> IO AstDisjoint+rawDisjoint (Disjoint es) = AstDisjoint+    <$> (newArray' =<< mapM rawDisjointElement es)+    <*> pure (fromIntegral . length $ es)++freeDisjoint :: AstDisjoint -> IO ()+freeDisjoint (AstDisjoint ls n) = freeArray ls n freeDisjointElement++fromRawDisjoint :: AstDisjoint -> IO (Disjoint (Symbol s))+fromRawDisjoint (AstDisjoint es n) = Disjoint+    <$> (mapM fromRawDisjointElement =<< peekArray (fromIntegral n) es)++data TheoryTermArray a = TheoryTermArray [TheoryTerm a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryTermArray :: TheoryTermArray (Symbol s) -> IO AstTheoryTermArray+rawTheoryTermArray (TheoryTermArray ts) = AstTheoryTermArray+    <$> (newArray' =<< mapM rawTheoryTerm ts)+    <*> pure (fromIntegral . length $ ts)++freeTheoryTermArray :: AstTheoryTermArray -> IO ()+freeTheoryTermArray (AstTheoryTermArray ts n) = freeArray ts n freeTheoryTerm++fromRawTheoryTermArray :: AstTheoryTermArray -> IO (TheoryTermArray (Symbol s))+fromRawTheoryTermArray (AstTheoryTermArray ts n) = TheoryTermArray+    <$> (mapM fromRawTheoryTerm =<< peekArray (fromIntegral n) ts)++data TheoryFunction a = TheoryFunction Text [TheoryTerm a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryFunction :: TheoryFunction (Symbol s) -> IO AstTheoryFunction+rawTheoryFunction (TheoryFunction t ts) = AstTheoryFunction+    <$> newCString (unpack t)+    <*> (newArray' =<< mapM rawTheoryTerm ts)+    <*> pure (fromIntegral . length $ ts)++freeTheoryFunction :: AstTheoryFunction -> IO ()+freeTheoryFunction (AstTheoryFunction s p n) = do+    free s+    freeArray p n freeTheoryTerm++fromRawTheoryFunction :: AstTheoryFunction -> IO (TheoryFunction (Symbol s))+fromRawTheoryFunction (AstTheoryFunction s ts n) = TheoryFunction+    <$> fmap pack (peekCString s)+    <*> (mapM fromRawTheoryTerm =<< peekArray (fromIntegral n) ts)++data TheoryUnparsedTermElement a = +    TheoryUnparsedTermElement [Text] (TheoryTerm a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryUnparsedTermElement :: TheoryUnparsedTermElement (Symbol s)+                             -> IO AstTheoryUnparsedTermElement+rawTheoryUnparsedTermElement (TheoryUnparsedTermElement ts t) =+    AstTheoryUnparsedTermElement+    <$> (newArray' =<< mapM (newCString . unpack) ts)+    <*> pure (fromIntegral . length $ ts)+    <*> rawTheoryTerm t++freeTheoryUnparsedTermElement :: AstTheoryUnparsedTermElement -> IO ()+freeTheoryUnparsedTermElement (AstTheoryUnparsedTermElement ss n t) = do+    freeTheoryTerm t+    freeArray ss n free++fromRawTheoryUnparsedTermElement :: AstTheoryUnparsedTermElement +                                 -> IO (TheoryUnparsedTermElement (Symbol s))+fromRawTheoryUnparsedTermElement (AstTheoryUnparsedTermElement ns n t) = +    TheoryUnparsedTermElement+    <$> (mapM (fmap pack . peekCString) =<< peekArray (fromIntegral n) ns)+    <*> fromRawTheoryTerm t++data TheoryUnparsedTerm a = TheoryUnparsedTerm [TheoryUnparsedTermElement a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryUnparsedTerm :: TheoryUnparsedTerm (Symbol s) +                      -> IO AstTheoryUnparsedTerm+rawTheoryUnparsedTerm (TheoryUnparsedTerm es) = AstTheoryUnparsedTerm+    <$> (newArray' =<< mapM rawTheoryUnparsedTermElement es)+    <*> pure (fromIntegral . length $ es)++freeTheoryUnparsedTerm :: AstTheoryUnparsedTerm -> IO ()+freeTheoryUnparsedTerm (AstTheoryUnparsedTerm es n) = +    freeArray es n freeTheoryUnparsedTermElement++fromRawTheoryUnparsedTerm :: AstTheoryUnparsedTerm +                          -> IO (TheoryUnparsedTerm (Symbol s)) +fromRawTheoryUnparsedTerm (AstTheoryUnparsedTerm es n) = TheoryUnparsedTerm+    <$> (mapM fromRawTheoryUnparsedTermElement +            =<< peekArray (fromIntegral n) es)++data TheoryTerm a+    = TheoryTermSymbol Location a+    | TheoryTermVariable Location Text+    | TheoryTermTuple Location (TheoryTermArray a)+    | TheoryTermList Location (TheoryTermArray a)+    | TheoryTermSet Location (TheoryTermArray a)+    | TheoryTermFunction Location (TheoryFunction a)+    | TheoryTermUnparsed Location (TheoryUnparsedTerm a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryTerm :: TheoryTerm (Symbol s) -> IO AstTheoryTerm+rawTheoryTerm (TheoryTermSymbol l s) = +    AstTheoryTermSymbol <$> rawLocation l <*> pure (rawSymbol s)+rawTheoryTerm (TheoryTermVariable l t) =+    AstTheoryTermVariable <$> rawLocation l <*> newCString (unpack t)+rawTheoryTerm (TheoryTermTuple l a) = +    AstTheoryTermTuple <$> rawLocation l <*> (new =<< rawTheoryTermArray a)+rawTheoryTerm (TheoryTermList l a) = +    AstTheoryTermList <$> rawLocation l <*> (new =<< rawTheoryTermArray a)+rawTheoryTerm (TheoryTermSet l a) = +    AstTheoryTermSet <$> rawLocation l <*> (new =<< rawTheoryTermArray a)+rawTheoryTerm (TheoryTermFunction l f) = +    AstTheoryTermFunction <$> rawLocation l <*> (new =<< rawTheoryFunction f)+rawTheoryTerm (TheoryTermUnparsed l t) = +    AstTheoryTermUnparsed <$> rawLocation l +                          <*> (new =<< rawTheoryUnparsedTerm t)++freeTheoryTerm :: AstTheoryTerm -> IO ()+freeTheoryTerm (AstTheoryTermSymbol l _) = freeRawLocation l+freeTheoryTerm (AstTheoryTermVariable l _) = freeRawLocation l+freeTheoryTerm (AstTheoryTermTuple l a) = do+    freeRawLocation l+    freeIndirection a freeTheoryTermArray+freeTheoryTerm (AstTheoryTermList l a) = do+    freeRawLocation l+    freeIndirection a freeTheoryTermArray+freeTheoryTerm (AstTheoryTermSet l a) = do+    freeRawLocation l+    freeIndirection a freeTheoryTermArray+freeTheoryTerm (AstTheoryTermFunction l f) = do+    freeRawLocation l +    freeIndirection f freeTheoryFunction+freeTheoryTerm (AstTheoryTermUnparsed l t) = do+    freeRawLocation l +    freeIndirection t freeTheoryUnparsedTerm++fromRawTheoryTerm :: AstTheoryTerm -> IO (TheoryTerm (Symbol s))+fromRawTheoryTerm (AstTheoryTermSymbol l s) = +    TheoryTermSymbol <$> fromRawLocation l <*> pureSymbol s+fromRawTheoryTerm (AstTheoryTermVariable l t) =+    TheoryTermVariable <$> fromRawLocation l <*> fmap pack (peekCString t)+fromRawTheoryTerm (AstTheoryTermTuple l a) =+    TheoryTermTuple <$> fromRawLocation l +                    <*> fromIndirect a fromRawTheoryTermArray+fromRawTheoryTerm (AstTheoryTermList l a) =+    TheoryTermList <$> fromRawLocation l +                   <*> fromIndirect a fromRawTheoryTermArray+fromRawTheoryTerm (AstTheoryTermSet l a) =+    TheoryTermSet <$> fromRawLocation l +                  <*> fromIndirect a fromRawTheoryTermArray+fromRawTheoryTerm (AstTheoryTermFunction l f) =+    TheoryTermFunction <$> fromRawLocation l +                       <*> fromIndirect f fromRawTheoryFunction+fromRawTheoryTerm (AstTheoryTermUnparsed l t) =+    TheoryTermUnparsed <$> fromRawLocation l +                       <*> fromIndirect t fromRawTheoryUnparsedTerm++data TheoryAtomElement a = TheoryAtomElement [TheoryTerm a] [Literal a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryAtomElement :: TheoryAtomElement (Symbol s) -> IO AstTheoryAtomElement+rawTheoryAtomElement (TheoryAtomElement ts ls) = AstTheoryAtomElement+    <$> (newArray' =<< mapM rawTheoryTerm ts)+    <*> pure (fromIntegral . length $ ts)+    <*> (newArray' =<< mapM rawLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeTheoryAtomElement :: AstTheoryAtomElement -> IO ()+freeTheoryAtomElement (AstTheoryAtomElement ts nt ls nl) = do+    freeArray ts nt freeTheoryTerm+    freeArray ls nl freeLiteral++fromRawTheoryAtomElement :: AstTheoryAtomElement +                         -> IO (TheoryAtomElement (Symbol s))+fromRawTheoryAtomElement (AstTheoryAtomElement ts nt ls nl) = TheoryAtomElement+    <$> (mapM fromRawTheoryTerm =<< peekArray (fromIntegral nt) ts)+    <*> (mapM fromRawLiteral =<< peekArray (fromIntegral nl) ls)++data TheoryGuard a = TheoryGuard Text (TheoryTerm a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryGuard :: TheoryGuard (Symbol s) -> IO AstTheoryGuard+rawTheoryGuard (TheoryGuard s t) = AstTheoryGuard+    <$> newCString (unpack s)+    <*> rawTheoryTerm t++freeTheoryGuard :: AstTheoryGuard -> IO ()+freeTheoryGuard (AstTheoryGuard s t) = free s >> freeTheoryTerm t++fromRawTheoryGuard :: AstTheoryGuard -> IO (TheoryGuard (Symbol s))+fromRawTheoryGuard (AstTheoryGuard n t) = TheoryGuard+    <$> fmap pack (peekCString n)+    <*> fromRawTheoryTerm t++data TheoryAtom a = TheoryAtom (Term a) [TheoryAtomElement a] (TheoryGuard a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawTheoryAtom :: TheoryAtom (Symbol s) -> IO AstTheoryAtom+rawTheoryAtom (TheoryAtom t es g) = AstTheoryAtom+    <$> rawTerm t+    <*> (newArray' =<< mapM rawTheoryAtomElement es)+    <*> pure (fromIntegral . length $ es)+    <*> rawTheoryGuard g++freeTheoryAtom :: AstTheoryAtom -> IO ()+freeTheoryAtom (AstTheoryAtom t es n g) = do+    freeTerm t+    freeTheoryGuard g+    freeArray es n freeTheoryAtomElement++fromRawTheoryAtom :: AstTheoryAtom -> IO (TheoryAtom (Symbol s))+fromRawTheoryAtom (AstTheoryAtom t es n g) = TheoryAtom+    <$> fromRawTerm t+    <*> (mapM fromRawTheoryAtomElement =<< peekArray (fromIntegral n) es)+    <*> fromRawTheoryGuard g++data HeadLiteral a+    = HeadLiteral Location (Literal a)+    | HeadDisjunction Location (Disjunction a)+    | HeadLitAggregate Location (Aggregate a)+    | HeadHeadAggregate Location (HeadAggregate a)+    | HeadTheoryAtom Location (TheoryAtom a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (HeadLiteral a) where+    pretty (HeadLiteral _ l) = pretty l+    pretty (HeadDisjunction _ d) = pretty d+    pretty (HeadLitAggregate _ a) = pretty a+    pretty (HeadHeadAggregate _ a) = pretty a+    pretty (HeadTheoryAtom _ _) = text "<theoryAtom>" -- TODO!++rawHeadLiteral :: HeadLiteral (Symbol s) -> IO AstHeadLiteral+rawHeadLiteral (HeadLiteral l x) = AstHeadLiteral+    <$> rawLocation l <*> (new =<< rawLiteral x)+rawHeadLiteral (HeadDisjunction l d) = AstHeadDisjunction+    <$> rawLocation l <*> (new =<< rawDisjunction d)+rawHeadLiteral (HeadLitAggregate l d) = AstHeadLitAggregate+    <$> rawLocation l <*> (new =<< rawAggregate d)+rawHeadLiteral (HeadHeadAggregate l d) = AstHeadHeadAggregate+    <$> rawLocation l <*> (new =<< rawHeadAggregate d)+rawHeadLiteral (HeadTheoryAtom l d) = AstHeadTheoryAtom+    <$> rawLocation l <*> (new =<< rawTheoryAtom d)++freeHeadLiteral :: AstHeadLiteral -> IO ()+freeHeadLiteral (AstHeadLiteral l x) = do+    freeRawLocation l+    freeIndirection x freeLiteral+freeHeadLiteral (AstHeadDisjunction l x) = do+    freeRawLocation l+    freeIndirection x freeDisjunction+freeHeadLiteral (AstHeadLitAggregate l x) = do+    freeRawLocation l+    freeIndirection x freeAggregate+freeHeadLiteral (AstHeadHeadAggregate l x) = do+    freeRawLocation l+    freeIndirection x freeHeadAggregate+freeHeadLiteral (AstHeadTheoryAtom l x) = do+    freeRawLocation l+    freeIndirection x freeTheoryAtom++fromRawHeadLiteral :: AstHeadLiteral -> IO (HeadLiteral (Symbol s))+fromRawHeadLiteral (AstHeadLiteral l x) = HeadLiteral+    <$> fromRawLocation l <*> fromIndirect x fromRawLiteral+fromRawHeadLiteral (AstHeadDisjunction l x) = HeadDisjunction+    <$> fromRawLocation l <*> fromIndirect x fromRawDisjunction+fromRawHeadLiteral (AstHeadLitAggregate l x) = HeadLitAggregate+    <$> fromRawLocation l <*> fromIndirect x fromRawAggregate+fromRawHeadLiteral (AstHeadHeadAggregate l x) = HeadHeadAggregate+    <$> fromRawLocation l <*> fromIndirect x fromRawHeadAggregate+fromRawHeadLiteral (AstHeadTheoryAtom l x) = HeadTheoryAtom+    <$> fromRawLocation l <*> fromIndirect x fromRawTheoryAtom++data BodyLiteral a+    = BodyLiteral Location Sign (Literal a)+    | BodyConditional Location (ConditionalLiteral a)+    | BodyLitAggregate Location Sign (Aggregate a)+    | BodyBodyAggregate Location Sign (BodyAggregate a)+    | BodyTheoryAtom Location Sign (TheoryAtom a)+    | BodyDisjoint Location Sign (Disjoint a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (BodyLiteral a) where+    pretty (BodyLiteral _ s l) = pretty s <+> pretty l+    pretty (BodyConditional _ c) = pretty c+    pretty (BodyLitAggregate _ s a) = pretty s <+> pretty a+    pretty (BodyBodyAggregate _ s a) = pretty s <+> pretty a+    pretty (BodyTheoryAtom _ s _) = pretty s <+> text "<theoryAtom>" -- TODO+    pretty (BodyDisjoint _ s _) = pretty s <+> text "<disjoint>" -- TODO++rawBodyLiteral :: BodyLiteral (Symbol s) -> IO AstBodyLiteral+rawBodyLiteral (BodyLiteral l s x) = AstBodyLiteral+    <$> rawLocation l <*> pure (rawSign s)+    <*> (new =<< rawLiteral x)+rawBodyLiteral (BodyConditional l x) = AstBodyConditional+    <$> rawLocation l+    <*> (new =<< rawConditionalLiteral x)+rawBodyLiteral (BodyLitAggregate l s x) = AstBodyLitAggregate+    <$> rawLocation l <*> pure (rawSign s)+    <*> (new =<< rawAggregate x)+rawBodyLiteral (BodyBodyAggregate l s x) = AstBodyBodyAggregate+    <$> rawLocation l <*> pure (rawSign s)+    <*> (new =<< rawBodyAggregate x)+rawBodyLiteral (BodyTheoryAtom l s x) = AstBodyTheoryAtom+    <$> rawLocation l <*> pure (rawSign s)+    <*> (new =<< rawTheoryAtom x)+rawBodyLiteral (BodyDisjoint l s x) = AstBodyDisjoint+    <$> rawLocation l <*> pure (rawSign s)+    <*> (new =<< rawDisjoint x)++freeBodyLiteral :: AstBodyLiteral -> IO ()+freeBodyLiteral (AstBodyLiteral l _ x) = do+    freeRawLocation l+    freeIndirection x freeLiteral+freeBodyLiteral (AstBodyConditional l x) = do+    freeRawLocation l+    freeIndirection x freeConditionalLiteral+freeBodyLiteral (AstBodyLitAggregate l _ x) = do+    freeRawLocation l+    freeIndirection x freeAggregate+freeBodyLiteral (AstBodyBodyAggregate l _ x) = do+    freeRawLocation l+    freeIndirection x freeBodyAggregate+freeBodyLiteral (AstBodyTheoryAtom l _ x) = do+    freeRawLocation l+    freeIndirection x freeTheoryAtom+freeBodyLiteral (AstBodyDisjoint l _ x) = do+    freeRawLocation l+    freeIndirection x freeDisjoint++fromRawBodyLiteral :: AstBodyLiteral -> IO (BodyLiteral (Symbol s))+fromRawBodyLiteral (AstBodyLiteral l s x) = BodyLiteral+    <$> fromRawLocation l <*> pure (fromRawSign s) +    <*> fromIndirect x fromRawLiteral+fromRawBodyLiteral (AstBodyConditional l x) = BodyConditional+    <$> fromRawLocation l <*> fromIndirect x fromRawConditionalLiteral+fromRawBodyLiteral (AstBodyLitAggregate l s x) = BodyLitAggregate+    <$> fromRawLocation l <*> pure (fromRawSign s) +    <*> fromIndirect x fromRawAggregate+fromRawBodyLiteral (AstBodyBodyAggregate l s x) = BodyBodyAggregate+    <$> fromRawLocation l <*> pure (fromRawSign s) +    <*> fromIndirect x fromRawBodyAggregate+fromRawBodyLiteral (AstBodyTheoryAtom l s x) = BodyTheoryAtom+    <$> fromRawLocation l <*> pure (fromRawSign s) +    <*> fromIndirect x fromRawTheoryAtom+fromRawBodyLiteral (AstBodyDisjoint l s x) = BodyDisjoint+    <$> fromRawLocation l <*> pure (fromRawSign s) +    <*> fromIndirect x fromRawDisjoint++data TheoryOperatorDefinition = +    TheoryOperatorDefinition Location Text Natural TheoryOperatorType+    deriving (Eq, Show, Ord)++rawTheoryOperatorDefinition :: TheoryOperatorDefinition +                            -> IO AstTheoryOperatorDefinition+rawTheoryOperatorDefinition (TheoryOperatorDefinition l s x t) = +    AstTheoryOperatorDefinition+    <$> rawLocation l+    <*> newCString (unpack s)+    <*> pure (fromIntegral x)+    <*> pure (rawTheoryOperatorType t)++freeTheoryOperatorDefinition :: AstTheoryOperatorDefinition -> IO ()+freeTheoryOperatorDefinition (AstTheoryOperatorDefinition l s _ _) =+    freeRawLocation l >> free s++fromRawTheoryOperatorDefinition :: AstTheoryOperatorDefinition +                                -> IO TheoryOperatorDefinition+fromRawTheoryOperatorDefinition (AstTheoryOperatorDefinition l s i t) = +    TheoryOperatorDefinition+    <$> fromRawLocation l+    <*> fmap pack (peekCString s)+    <*> pure (fromIntegral i)+    <*> pure (fromRawTheoryOperatorType t)++data TheoryOperatorType = Unary | BinLeft | BinRight+    deriving (Eq, Show, Ord)++rawTheoryOperatorType :: TheoryOperatorType -> AstTheoryOperatorType+rawTheoryOperatorType t = case t of+    Unary -> AstTheoryOperatorTypeUnary+    BinLeft -> AstTheoryOperatorTypeBinaryLeft+    BinRight -> AstTheoryOperatorTypeBinaryRight++fromRawTheoryOperatorType :: AstTheoryOperatorType -> TheoryOperatorType+fromRawTheoryOperatorType t = case t of+    AstTheoryOperatorTypeUnary -> Unary +    AstTheoryOperatorTypeBinaryLeft -> BinLeft +    AstTheoryOperatorTypeBinaryRight -> BinRight +    _ -> error "Invalid clingo_ast_theory_operator_type_t"++data TheoryTermDefinition =+    TheoryTermDefinition Location Text [TheoryOperatorDefinition]+    deriving (Eq, Show, Ord)++rawTheoryTermDefinition :: TheoryTermDefinition -> IO AstTheoryTermDefinition+rawTheoryTermDefinition (TheoryTermDefinition l s xs) = AstTheoryTermDefinition+    <$> rawLocation l+    <*> newCString (unpack s)+    <*> (newArray' =<< mapM rawTheoryOperatorDefinition xs)+    <*> pure (fromIntegral . length $ xs)++freeTheoryTermDefinition :: AstTheoryTermDefinition -> IO ()+freeTheoryTermDefinition (AstTheoryTermDefinition l s xs n) = do+    freeRawLocation l+    free s+    freeArray xs n freeTheoryOperatorDefinition++fromRawTheoryTermDefinition :: AstTheoryTermDefinition +                            -> IO TheoryTermDefinition+fromRawTheoryTermDefinition (AstTheoryTermDefinition l s es n) =+    TheoryTermDefinition+    <$> fromRawLocation l+    <*> fmap pack (peekCString s)+    <*> (mapM fromRawTheoryOperatorDefinition =<< peekArray (fromIntegral n) es)++data TheoryGuardDefinition =+    TheoryGuardDefinition Text [Text]+    deriving (Eq, Show, Ord)++rawTheoryGuardDefinition :: TheoryGuardDefinition -> IO AstTheoryGuardDefinition+rawTheoryGuardDefinition (TheoryGuardDefinition t ts) = AstTheoryGuardDefinition+    <$> newCString (unpack t)+    <*> (newArray' =<< mapM (newCString . unpack) ts)+    <*> pure (fromIntegral . length $ ts)++freeTheoryGuardDefinition :: AstTheoryGuardDefinition -> IO ()+freeTheoryGuardDefinition (AstTheoryGuardDefinition s ss n) = do+    free s+    freeArray ss n free++fromRawTheoryGuardDefinition :: AstTheoryGuardDefinition +                             -> IO TheoryGuardDefinition+fromRawTheoryGuardDefinition (AstTheoryGuardDefinition t ts n) =+    TheoryGuardDefinition+    <$> fmap pack (peekCString t)+    <*> (mapM (fmap pack . peekCString) =<< peekArray (fromIntegral n) ts)++data TheoryAtomDefinition =+    TheoryAtomDefinition Location TheoryAtomDefinitionType +                         Text Int Text TheoryGuardDefinition+    deriving (Eq, Show, Ord)++rawTheoryAtomDefinition :: TheoryAtomDefinition -> IO AstTheoryAtomDefinition+rawTheoryAtomDefinition (TheoryAtomDefinition l t a i b d) =+    AstTheoryAtomDefinition+    <$> rawLocation l+    <*> pure (rawTheoryAtomDefinitionType t)+    <*> newCString (unpack a)+    <*> pure (fromIntegral i)+    <*> newCString (unpack b)+    <*> (new =<< rawTheoryGuardDefinition d)++freeTheoryAtomDefinition :: AstTheoryAtomDefinition -> IO ()+freeTheoryAtomDefinition (AstTheoryAtomDefinition l _ a _ b p) = do+    freeRawLocation l+    free a+    free b+    freeIndirection p freeTheoryGuardDefinition++fromRawTheoryAtomDefinition :: AstTheoryAtomDefinition +                            -> IO TheoryAtomDefinition+fromRawTheoryAtomDefinition (AstTheoryAtomDefinition l t a i b g) =+    TheoryAtomDefinition+    <$> fromRawLocation l+    <*> pure (fromRawTheoryAtomDefinitionType t)+    <*> fmap pack (peekCString a)+    <*> pure (fromIntegral i)+    <*> fmap pack (peekCString b)+    <*> fromIndirect g fromRawTheoryGuardDefinition++data TheoryAtomDefinitionType = Head | Body | Any | Directive+    deriving (Eq, Show, Ord)++rawTheoryAtomDefinitionType :: TheoryAtomDefinitionType +                            -> AstTheoryAtomDefType+rawTheoryAtomDefinitionType t = case t of+    Head -> AstTheoryAtomDefinitionTypeHead+    Body -> AstTheoryAtomDefinitionTypeBody+    Any -> AstTheoryAtomDefinitionTypeAny+    Directive -> AstTheoryAtomDefinitionTypeDirective++fromRawTheoryAtomDefinitionType :: AstTheoryAtomDefType +                                -> TheoryAtomDefinitionType+fromRawTheoryAtomDefinitionType t = case t of+    AstTheoryAtomDefinitionTypeHead -> Head +    AstTheoryAtomDefinitionTypeBody -> Body +    AstTheoryAtomDefinitionTypeAny -> Any +    AstTheoryAtomDefinitionTypeDirective -> Directive +    _ -> error "Invalid clingo_ast_theory_atom_definition_type_t"++data TheoryDefinition =+    TheoryDefinition Text [TheoryTermDefinition] [TheoryAtomDefinition]+    deriving (Eq, Show, Ord)++rawTheoryDefinition :: TheoryDefinition -> IO AstTheoryDefinition+rawTheoryDefinition (TheoryDefinition t ts as) = AstTheoryDefinition+    <$> newCString (unpack t)+    <*> (newArray' =<< mapM rawTheoryTermDefinition ts)+    <*> pure (fromIntegral . length $ ts)+    <*> (newArray' =<< mapM rawTheoryAtomDefinition as)+    <*> pure (fromIntegral . length $ as)++freeTheoryDefinition :: AstTheoryDefinition -> IO ()+freeTheoryDefinition (AstTheoryDefinition t ts nt as na) = do+    free t+    freeArray ts nt freeTheoryTermDefinition+    freeArray as na freeTheoryAtomDefinition++fromRawTheoryDefinition :: AstTheoryDefinition -> IO TheoryDefinition+fromRawTheoryDefinition (AstTheoryDefinition s ts nt as na) = TheoryDefinition+    <$> fmap pack (peekCString s)+    <*> (mapM fromRawTheoryTermDefinition =<< peekArray (fromIntegral nt) ts)+    <*> (mapM fromRawTheoryAtomDefinition =<< peekArray (fromIntegral na) as)++data Rule a = Rule (HeadLiteral a) [BodyLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Rule a) where+    pretty (Rule h []) = pretty h+    pretty (Rule h bs) = +        pretty h <+> text ":-" +                 <+> align (sep (punctuate comma (map pretty bs)))++rawRule :: Rule (Symbol s) -> IO AstRule+rawRule (Rule h bs) = AstRule+    <$> rawHeadLiteral h <*> (newArray' =<< mapM rawBodyLiteral bs)+                         <*> pure (fromIntegral . length $ bs)++freeRule :: AstRule -> IO ()+freeRule (AstRule h bs n) = do+    freeHeadLiteral h+    freeArray bs n freeBodyLiteral++fromRawRule :: AstRule -> IO (Rule (Symbol s))+fromRawRule (AstRule h bs n) = Rule+    <$> fromRawHeadLiteral h+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) bs)++data Definition a = Definition Text (Term a) Bool+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawDefinition :: Definition (Symbol s) -> IO AstDefinition+rawDefinition (Definition s t b) = AstDefinition+    <$> newCString (unpack s)+    <*> rawTerm t+    <*> pure (fromBool b)++freeDefinition :: AstDefinition -> IO ()+freeDefinition (AstDefinition s t _) = free s >> freeTerm t++fromRawDefinition :: AstDefinition -> IO (Definition (Symbol s))+fromRawDefinition (AstDefinition s t b) = Definition+    <$> fmap pack (peekCString s)+    <*> fromRawTerm t+    <*> pure (toBool b)++data ShowSignature b = ShowSignature b Bool+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawShowSignature :: ShowSignature (Signature b) -> IO AstShowSignature+rawShowSignature (ShowSignature s b) = AstShowSignature+    <$> pure (rawSignature s)+    <*> pure (fromBool b)++freeShowSignature :: AstShowSignature -> IO ()+freeShowSignature (AstShowSignature _ _) = return ()++fromRawShowSignature :: AstShowSignature -> IO (ShowSignature (Signature s))+fromRawShowSignature (AstShowSignature s b) = ShowSignature+    <$> pureSignature s+    <*> pure (toBool b)++data ShowTerm a = ShowTerm (Term a) [BodyLiteral a] Bool+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawShowTerm :: ShowTerm (Symbol s) -> IO AstShowTerm+rawShowTerm (ShowTerm t ls b) = AstShowTerm+    <$> rawTerm t+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)+    <*> pure (fromBool b)++freeShowTerm :: AstShowTerm -> IO ()+freeShowTerm (AstShowTerm t ls n _) = do+    freeTerm t+    freeArray ls n freeBodyLiteral++fromRawShowTerm :: AstShowTerm -> IO (ShowTerm (Symbol s))+fromRawShowTerm (AstShowTerm t ls n b) = ShowTerm+    <$> fromRawTerm t+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) ls)+    <*> pure (toBool b)++data Minimize a = Minimize (Term a) (Term a) [Term a] [BodyLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawMinimize :: Minimize (Symbol s) -> IO AstMinimize+rawMinimize (Minimize a b ts ls) = AstMinimize+    <$> rawTerm a+    <*> rawTerm b+    <*> (newArray' =<< mapM rawTerm ts)+    <*> pure (fromIntegral . length $ ts)+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeMinimize :: AstMinimize -> IO ()+freeMinimize (AstMinimize a b ts nt ls nl) = do+    freeTerm a+    freeTerm b+    freeArray ts nt freeTerm+    freeArray ls nl freeBodyLiteral++fromRawMinimize :: AstMinimize -> IO (Minimize (Symbol s))+fromRawMinimize (AstMinimize a b ts nt ls nl) = Minimize+    <$> fromRawTerm a+    <*> fromRawTerm b+    <*> (mapM fromRawTerm =<< peekArray (fromIntegral nt) ts)+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral nl) ls)++data Script = Script ScriptType Text+    deriving (Eq, Show, Ord)++rawScript :: Script -> IO AstScript+rawScript (Script t s) = AstScript+    <$> pure (rawScriptType t)+    <*> newCString (unpack s)++freeScript :: AstScript -> IO ()+freeScript (AstScript _ s) = free s++fromRawScript :: AstScript -> IO Script+fromRawScript (AstScript t s) = Script+    <$> pure (fromRawScriptType t)+    <*> fmap pack (peekCString s)++data ScriptType = Lua | Python+    deriving (Eq, Show, Ord)++rawScriptType :: ScriptType -> AstScriptType+rawScriptType t = case t of+    Lua -> AstScriptTypeLua+    Python -> AstScriptTypePython++fromRawScriptType :: AstScriptType -> ScriptType+fromRawScriptType t = case t of+    AstScriptTypeLua -> Lua +    AstScriptTypePython -> Python +    _ -> error "Invalid clingo_ast_script_type_t"++data Program = Program Text [Identifier]+    deriving (Eq, Show, Ord)++instance Pretty Program where+    pretty (Program n []) =+        text "#program" <+> text (fromStrict n)+    pretty (Program n is) = +        text "#program" <+> text (fromStrict n) <> tupled (map pretty is)++rawProgram :: Program -> IO AstProgram+rawProgram (Program n is) = AstProgram+    <$> newCString (unpack n)+    <*> (newArray' =<< mapM rawIdentifier is)+    <*> pure (fromIntegral . length $ is)++freeProgram :: AstProgram -> IO ()+freeProgram (AstProgram s xs n) = free s >> freeArray xs n freeIdentifier++fromRawProgram :: AstProgram -> IO Program+fromRawProgram (AstProgram s es n) = Program+    <$> fmap pack (peekCString s)+    <*> (mapM fromRawIdentifier =<< peekArray (fromIntegral n) es)++data External a = External (Term a) [BodyLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (External a) where+    pretty (External n []) =+        text "#external" <+> pretty n+    pretty (External n is) = +        text "#external" <+> pretty n <> tupled (map pretty is)++rawExternal :: External (Symbol s) -> IO AstExternal+rawExternal (External t ls) = AstExternal+    <$> rawTerm t+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeExternal :: AstExternal -> IO ()+freeExternal (AstExternal t ls n) = freeTerm t >> freeArray ls n freeBodyLiteral++fromRawExternal :: AstExternal -> IO (External (Symbol s))+fromRawExternal (AstExternal t ls n) = External+    <$> fromRawTerm t+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) ls)++data Edge a = Edge (Term a) (Term a) [BodyLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawEdge :: Edge (Symbol s) -> IO AstEdge+rawEdge (Edge a b ls) = AstEdge+    <$> rawTerm a+    <*> rawTerm b+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeEdge :: AstEdge -> IO ()+freeEdge (AstEdge a b ls n) = do+    freeTerm a+    freeTerm b+    freeArray ls n freeBodyLiteral++fromRawEdge :: AstEdge -> IO (Edge (Symbol s))+fromRawEdge (AstEdge a b ls n) = Edge+    <$> fromRawTerm a+    <*> fromRawTerm b+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) ls)++data Heuristic a = Heuristic (Term a) [BodyLiteral a] (Term a) (Term a) (Term a)+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance Pretty a => Pretty (Heuristic a) where+    pretty (Heuristic t1 [] t2 t3 t4) = +        text "#heuristic" <+> pretty t1+                          <> dot <+> char '[' <+> pretty t2 <> char '@' +                          <> pretty t3 <+> comma <+> pretty t4 <+> char ']'+    pretty (Heuristic t1 cs t2 t3 t4) = +        text "#heuristic" <+> pretty t1 <+> colon <+> list (map pretty cs) +                          <> dot <+> char '[' <+> pretty t2 <> char '@' +                          <> pretty t3 <+> comma <+> pretty t4 <+> char ']'++rawHeuristic :: Heuristic (Symbol s) -> IO AstHeuristic+rawHeuristic (Heuristic a ls b c d) = AstHeuristic+    <$> rawTerm a+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)+    <*> rawTerm b+    <*> rawTerm c+    <*> rawTerm d++freeHeuristic :: AstHeuristic -> IO ()+freeHeuristic (AstHeuristic a ls n b c d) = do+    freeTerm a+    freeTerm b+    freeTerm c+    freeTerm d+    freeArray ls n freeBodyLiteral++fromRawHeuristic :: AstHeuristic -> IO (Heuristic (Symbol s))+fromRawHeuristic (AstHeuristic t ls n a b c) = Heuristic+    <$> fromRawTerm t+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) ls)+    <*> fromRawTerm a+    <*> fromRawTerm b+    <*> fromRawTerm c++data Project a = Project (Term a) [BodyLiteral a]+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++rawProject :: Project (Symbol s) -> IO AstProject+rawProject (Project t ls) = AstProject+    <$> rawTerm t+    <*> (newArray' =<< mapM rawBodyLiteral ls)+    <*> pure (fromIntegral . length $ ls)++freeProject :: AstProject -> IO ()+freeProject (AstProject t ls n) = do+    freeTerm t+    freeArray ls n freeBodyLiteral++fromRawProject :: AstProject -> IO (Project (Symbol s))+fromRawProject (AstProject t ls n) = Project+    <$> fromRawTerm t+    <*> (mapM fromRawBodyLiteral =<< peekArray (fromIntegral n) ls)++data Statement a b+    = StmtRule Location (Rule a)+    | StmtDefinition Location (Definition a)+    | StmtShowSignature Location (ShowSignature b)+    | StmtShowTerm Location (ShowTerm a)+    | StmtMinimize Location (Minimize a)+    | StmtScript Location Script+    | StmtProgram Location Program+    | StmtExternal Location (External a)+    | StmtEdge Location (Edge a)+    | StmtHeuristic Location (Heuristic a)+    | StmtProject Location (Project a)+    | StmtSignature Location b+    | StmtTheoryDefinition Location TheoryDefinition+    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)++instance (Pretty a, Pretty b) => Pretty (Statement a b) where+    pretty (StmtRule _ r) = pretty r <> dot+    pretty (StmtSignature _ s) = pretty s <> dot+    pretty (StmtProgram _ p) = pretty p <> dot+    pretty (StmtExternal _ p) = pretty p <> dot+    pretty (StmtHeuristic _ p) = pretty p+    pretty _ = text "<stmt>" -- TODO++instance Bifunctor Statement where+    bimap f g s = case s of+        StmtRule l x -> StmtRule l (fmap f x)+        StmtDefinition l x -> StmtDefinition l (fmap f x)+        StmtShowSignature l x -> StmtShowSignature l (fmap g x)+        StmtShowTerm l x -> StmtShowTerm l (fmap f x)+        StmtMinimize l x -> StmtMinimize l (fmap f x)+        StmtScript l x -> StmtScript l x+        StmtProgram l x -> StmtProgram l x+        StmtExternal l x -> StmtExternal l (fmap f x)+        StmtEdge l x -> StmtEdge l (fmap f x)+        StmtHeuristic l x -> StmtHeuristic l (fmap f x)+        StmtProject l x -> StmtProject l (fmap f x)+        StmtSignature l x -> StmtSignature l (g x)+        StmtTheoryDefinition l x -> StmtTheoryDefinition l x++instance Bifoldable Statement where+    bifoldr f g z s = case s of+        StmtRule _ x -> foldr f z x+        StmtDefinition _ x -> foldr f z x+        StmtShowSignature _ x -> foldr g z x+        StmtShowTerm _ x -> foldr f z x+        StmtMinimize _ x -> foldr f z x+        StmtScript _ _ -> z+        StmtProgram _ _ -> z+        StmtExternal _ x -> foldr f z x+        StmtEdge _ x -> foldr f z x+        StmtHeuristic _ x -> foldr f z x+        StmtProject _ x -> foldr f z x+        StmtSignature _ x -> g x z+        StmtTheoryDefinition _ _ -> z++instance Bitraversable Statement where+    bitraverse f g s = case s of+        StmtRule l x -> StmtRule l <$> traverse f x+        StmtDefinition l x -> StmtDefinition l <$> traverse f x+        StmtShowSignature l x -> StmtShowSignature l <$> traverse g x+        StmtShowTerm l x -> StmtShowTerm l <$> traverse f x+        StmtMinimize l x -> StmtMinimize l <$> traverse f x+        StmtScript l x -> pure $ StmtScript l x+        StmtProgram l x -> pure $ StmtProgram l x+        StmtExternal l x -> StmtExternal l <$> traverse f x+        StmtEdge l x -> StmtEdge l <$> traverse f x+        StmtHeuristic l x -> StmtHeuristic l <$> traverse f x+        StmtProject l x -> StmtProject l <$> traverse f x+        StmtSignature l x -> StmtSignature l <$> g x+        StmtTheoryDefinition l x -> pure $ StmtTheoryDefinition l x++rawStatement :: Statement (Symbol s) (Signature s) -> IO AstStatement+rawStatement (StmtRule l x) = AstStmtRule+    <$> rawLocation l <*> (new =<< rawRule x)+rawStatement (StmtDefinition l x) = AstStmtDefinition+    <$> rawLocation l <*> (new =<< rawDefinition x)+rawStatement (StmtShowSignature l x) = AstStmtShowSignature+    <$> rawLocation l <*> (new =<< rawShowSignature x)+rawStatement (StmtShowTerm l x) = AstStmtShowTerm+    <$> rawLocation l <*> (new =<< rawShowTerm x)+rawStatement (StmtMinimize l x) = AstStmtMinimize+    <$> rawLocation l <*> (new =<< rawMinimize x)+rawStatement (StmtScript l x) = AstStmtScript+    <$> rawLocation l <*> (new =<< rawScript x)+rawStatement (StmtProgram l x) = AstStmtProgram+    <$> rawLocation l <*> (new =<< rawProgram x)+rawStatement (StmtExternal l x) = AstStmtExternal+    <$> rawLocation l <*> (new =<< rawExternal x)+rawStatement (StmtEdge l x) = AstStmtEdge+    <$> rawLocation l <*> (new =<< rawEdge x)+rawStatement (StmtHeuristic l x) = AstStmtHeuristic+    <$> rawLocation l <*> (new =<< rawHeuristic x)+rawStatement (StmtProject l x) = AstStmtProject+    <$> rawLocation l <*> (new =<< rawProject x)+rawStatement (StmtSignature l x) = AstStmtSignature+    <$> rawLocation l <*> pure (rawSignature x)+rawStatement (StmtTheoryDefinition l x) = AstStmtTheoryDefn+    <$> rawLocation l <*> (new =<< rawTheoryDefinition x)++freeStatement :: AstStatement -> IO ()+freeStatement (AstStmtRule l x) = +    freeRawLocation l >> freeIndirection x freeRule+freeStatement (AstStmtDefinition l x) = +    freeRawLocation l >> freeIndirection x freeDefinition+freeStatement (AstStmtShowSignature l x) = +    freeRawLocation l >> freeIndirection x freeShowSignature+freeStatement (AstStmtShowTerm l x) = +    freeRawLocation l >> freeIndirection x freeShowTerm+freeStatement (AstStmtMinimize l x) = +    freeRawLocation l >> freeIndirection x freeMinimize+freeStatement (AstStmtScript l x) = +    freeRawLocation l >> freeIndirection x freeScript+freeStatement (AstStmtProgram l x) = +    freeRawLocation l >> freeIndirection x freeProgram+freeStatement (AstStmtExternal l x) = +    freeRawLocation l >> freeIndirection x freeExternal+freeStatement (AstStmtEdge l x) = +    freeRawLocation l >> freeIndirection x freeEdge+freeStatement (AstStmtHeuristic l x) = +    freeRawLocation l >> freeIndirection x freeHeuristic+freeStatement (AstStmtProject l x) = +    freeRawLocation l >> freeIndirection x freeProject+freeStatement (AstStmtSignature l _) = freeRawLocation l+freeStatement (AstStmtTheoryDefn l x) =+    freeRawLocation l >> freeIndirection x freeTheoryDefinition++fromRawStatement :: AstStatement -> IO (Statement (Symbol s) (Signature s))+fromRawStatement (AstStmtRule l x) = +    StmtRule <$> fromRawLocation l <*> fromIndirect x fromRawRule+fromRawStatement (AstStmtDefinition l x) = +    StmtDefinition <$> fromRawLocation l <*> fromIndirect x fromRawDefinition+fromRawStatement (AstStmtShowSignature l x) = +    StmtShowSignature <$> fromRawLocation l +                      <*> fromIndirect x fromRawShowSignature+fromRawStatement (AstStmtShowTerm l x) = +    StmtShowTerm <$> fromRawLocation l <*> fromIndirect x fromRawShowTerm+fromRawStatement (AstStmtMinimize l x) = +    StmtMinimize <$> fromRawLocation l <*> fromIndirect x fromRawMinimize+fromRawStatement (AstStmtScript l x) = +    StmtScript <$> fromRawLocation l <*> fromIndirect x fromRawScript+fromRawStatement (AstStmtProgram l x) = +    StmtProgram <$> fromRawLocation l <*> fromIndirect x fromRawProgram+fromRawStatement (AstStmtExternal l x) = +    StmtExternal <$> fromRawLocation l <*> fromIndirect x fromRawExternal+fromRawStatement (AstStmtEdge l x) = +    StmtEdge <$> fromRawLocation l <*> fromIndirect x fromRawEdge+fromRawStatement (AstStmtHeuristic l x) = +    StmtHeuristic <$> fromRawLocation l <*> fromIndirect x fromRawHeuristic+fromRawStatement (AstStmtProject l x) = +    StmtProject <$> fromRawLocation l <*> fromIndirect x fromRawProject+fromRawStatement (AstStmtSignature l x) = +    StmtSignature <$> fromRawLocation l <*> pureSignature x+fromRawStatement (AstStmtTheoryDefn l x) =+    StmtTheoryDefinition <$> fromRawLocation l +                         <*> fromIndirect x fromRawTheoryDefinition
+ src/Clingo/Internal/Configuration.hs view
@@ -0,0 +1,125 @@+-- | A module providing direct, but memory managed access to the Clingo+-- configuration interface. The preferred way to interface with configuration is+-- found in 'Clingo.Configuration'. This interface exists solely for users who+-- want to provide their own abstraction, without having to reimplement memory+-- management for the raw versions in 'Clingo.Raw.Configuration'+module Clingo.Internal.Configuration+(+    Configuration,+    ConfigurationType (..),+    CKey,+    configurationRoot,+    configurationType, +    configurationDescription,+    +    -- ** Array Access+    configurationArraySize,+    configurationArrayAt,++    -- ** Map Access+    configurationMapSize,+    configurationMapSubkeyName,+    configurationMapAt,++    -- ** Value Access+    configurationValueGet,+    configurationValueIsAssigned,+    configurationValueSet+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch+import Numeric.Natural+import Data.Word+import Data.Bits+import Data.Text (Text, pack, unpack)++import Foreign+import Foreign.C++import qualified Clingo.Raw as Raw+import Clingo.Internal.Types+import Clingo.Internal.Utils++newtype CKey = CKey Word32+    deriving (Show, Eq, Ord)++configurationRoot :: (MonadIO m, MonadThrow m) +                  => Configuration s -> m CKey +configurationRoot (Configuration c) = +    CKey . fromIntegral <$> marshall1 (Raw.configurationRoot c)++data ConfigurationType = CType+    { hasValue :: Bool+    , hasArray :: Bool+    , hasMap   :: Bool }+    deriving (Show, Eq, Read, Ord)++fromRawConfigurationType :: Raw.ConfigurationType -> ConfigurationType+fromRawConfigurationType t = CType v a m+    where v = toBool $ t .&. Raw.ConfigValue+          a = toBool $ t .&. Raw.ConfigArray+          m = toBool $ t .&. Raw.ConfigMap++configurationType :: (MonadIO m, MonadThrow m) +               => Configuration s -> CKey -> m ConfigurationType+configurationType (Configuration s) (CKey k) = +    fromRawConfigurationType <$> +        marshall1 (Raw.configurationType s (fromIntegral k))++configurationArraySize :: (MonadIO m, MonadThrow m) +                    => Configuration s -> CKey -> m Natural+configurationArraySize (Configuration s) (CKey k) = +    fromIntegral <$> marshall1 (Raw.configurationArraySize s (fromIntegral k))++configurationArrayAt :: (MonadIO m, MonadThrow m)+                  => Configuration s -> CKey -> Natural -> m CKey+configurationArrayAt (Configuration s) (CKey k) offset =+    CKey . fromIntegral <$> marshall1 +        (Raw.configurationArrayAt s (fromIntegral k) (fromIntegral offset))++configurationMapSize :: (MonadIO m, MonadThrow m)+                  => Configuration s -> CKey -> m Natural+configurationMapSize (Configuration s) (CKey k) =+    fromIntegral <$> marshall1 (Raw.configurationMapSize s (fromIntegral k))++configurationMapSubkeyName :: (MonadIO m, MonadThrow m)+                        => Configuration s -> CKey -> Natural -> m Text+configurationMapSubkeyName (Configuration s) (CKey k) offset = do+    cstr <- marshall1 (Raw.configurationMapSubkeyName s (fromIntegral k) +                                                        (fromIntegral offset))+    pack <$> liftIO (peekCString cstr)++configurationMapAt :: (MonadIO m, MonadThrow m)+                => Configuration s -> CKey -> Text -> m CKey+configurationMapAt (Configuration s) (CKey k) name =+    CKey . fromIntegral <$> marshall1 go+    where go = withCString (unpack name) . +               flip (Raw.configurationMapAt s (fromIntegral k))++configurationValueGet :: (MonadIO m) +                      => Configuration s -> CKey -> m Text+configurationValueGet (Configuration s) (CKey k) = liftIO $ do+    len <- marshall1 (Raw.configurationValueGetSize s (fromIntegral k))+    allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.configurationValueGet s (fromIntegral k) arr len)+        as <- peekArray (fromIntegral len) arr+        pure . pack . map castCCharToChar $ as++configurationDescription :: (MonadIO m, MonadThrow m)+                         => Configuration s -> CKey -> m Text+configurationDescription (Configuration c) (CKey k) = do+    s <- marshall1 (Raw.configurationDescription c (fromIntegral k))+    pack <$> liftIO (peekCString s)++configurationValueIsAssigned :: (MonadIO m, MonadThrow m)+                             => Configuration s -> CKey -> m Bool+configurationValueIsAssigned (Configuration c) (CKey k) =+    toBool <$> marshall1 (Raw.configurationValueIsAssigned c (fromIntegral k))++configurationValueSet :: (MonadIO m, MonadThrow m)+                      => Configuration s -> CKey -> Text -> m ()+configurationValueSet (Configuration s) (CKey k) v = marshall0 go+    where go = withCString (unpack v) $ \str ->+                   Raw.configurationValueSet s (fromIntegral k) str
+ src/Clingo/Internal/Inspection/Symbolic.hs view
@@ -0,0 +1,102 @@+-- | Module providing direct access to the C style iterator interface for+-- symbolic atom inspection. A version abstracting this into lists is provided+-- in 'Clingo.Inspection.Symbolic'. This module is exported for users who want+-- to build their own iterator abstraction.+module Clingo.Internal.Inspection.Symbolic+(+    SymbolicAtoms,+    SIterator,+    symbolicAtomsSize,+    symbolicAtomsBegin,+    symbolicAtomsEnd,+    symbolicAtomsNext,+    symbolicAtomsIsValid,+    symbolicAtomsFind,+    symbolicAtomsIteratorEq,+    symbolicAtomsSymbol,+    symbolicAtomsIsFact,+    symbolicAtomsIsExternal,+    symbolicAtomsLiteral,+    symbolicAtomsSignatures,+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch++import Numeric.Natural+import Foreign++import qualified Clingo.Raw as Raw+import Clingo.Internal.Types+import Clingo.Internal.Utils+import Clingo.Internal.Symbol++newtype SIterator s = SIterator Raw.SymbolicAtomIterator++symbolicAtomsSize :: (MonadIO m, MonadThrow m)+                  => SymbolicAtoms s -> m Natural+symbolicAtomsSize (SymbolicAtoms s) = +    fromIntegral <$> marshall1 (Raw.symbolicAtomsSize s)++symbolicAtomsBegin :: (MonadIO m, MonadThrow m)+                   => SymbolicAtoms s -> Maybe (Signature s) -> m (SIterator s)+symbolicAtomsBegin (SymbolicAtoms s) sig = SIterator <$> marshall1 go+    where go x = case sig of+                     Nothing -> Raw.symbolicAtomsBegin s nullPtr x+                     Just y  -> with (rawSignature y) $ \ptr ->+                                    Raw.symbolicAtomsBegin s ptr x++symbolicAtomsEnd :: (MonadIO m, MonadThrow m)+                   => SymbolicAtoms s -> m (SIterator s)+symbolicAtomsEnd (SymbolicAtoms s) = SIterator <$> marshall1 go+    where go = Raw.symbolicAtomsEnd s++symbolicAtomsFind :: (MonadIO m, MonadThrow m)+                  => SymbolicAtoms s -> Symbol s -> m (SIterator s)+symbolicAtomsFind (SymbolicAtoms s) sym = SIterator <$> marshall1+    (Raw.symbolicAtomsFind s (rawSymbol sym))++symbolicAtomsIteratorEq :: (MonadIO m, MonadThrow m)+                        => SymbolicAtoms s -> SIterator s -> SIterator s+                        -> m Bool+symbolicAtomsIteratorEq (SymbolicAtoms s) (SIterator a) (SIterator b) =+    toBool <$> marshall1 (Raw.symbolicAtomsIteratorIsEqualTo s a b)++symbolicAtomsSymbol :: (MonadIO m, MonadThrow m)+                    => SymbolicAtoms s -> SIterator s -> m (Symbol s)+symbolicAtomsSymbol (SymbolicAtoms s) (SIterator i) =+    pureSymbol =<< marshall1 (Raw.symbolicAtomsSymbol s i)++symbolicAtomsIsFact :: (MonadIO m, MonadThrow m)+                    => SymbolicAtoms s -> SIterator s -> m Bool+symbolicAtomsIsFact (SymbolicAtoms s) (SIterator i) = +    toBool <$> marshall1 (Raw.symbolicAtomsIsFact s i)++symbolicAtomsIsExternal :: (MonadIO m, MonadThrow m)+                        => SymbolicAtoms s -> SIterator s -> m Bool+symbolicAtomsIsExternal (SymbolicAtoms s) (SIterator i) = +    toBool <$> marshall1 (Raw.symbolicAtomsIsExternal s i)++symbolicAtomsLiteral :: (MonadIO m, MonadThrow m)+                     => SymbolicAtoms s -> SIterator s -> m (AspifLiteral s)+symbolicAtomsLiteral (SymbolicAtoms s) (SIterator i) =+    AspifLiteral <$> marshall1 (Raw.symbolicAtomsLiteral s i)++symbolicAtomsSignatures :: (MonadIO m, MonadThrow m)+                        => SymbolicAtoms s -> m [Signature s]+symbolicAtomsSignatures (SymbolicAtoms s) = do+    len <- marshall1 (Raw.symbolicAtomsSignaturesSize s)+    liftIO $ allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.symbolicAtomsSignatures s arr len)+        mapM pureSignature =<< peekArray (fromIntegral len) arr++symbolicAtomsNext :: (MonadIO m, MonadThrow m)+                  => SymbolicAtoms s -> SIterator s -> m (SIterator s)+symbolicAtomsNext (SymbolicAtoms s) (SIterator i) = SIterator <$>+    marshall1 (Raw.symbolicAtomsNext s i)++symbolicAtomsIsValid :: (MonadIO m, MonadThrow m)+                     => SymbolicAtoms s -> SIterator s -> m Bool+symbolicAtomsIsValid (SymbolicAtoms s) (SIterator i) = toBool <$>+    marshall1 (Raw.symbolicAtomsIsValid s i)
+ src/Clingo/Internal/Inspection/Theory.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Internal.Inspection.Theory+(+    TheoryAtoms,+    TermId,+    ElementId,+    AtomId,+    TheoryTermType,++    pattern TheoryTuple,+    pattern TheoryList,+    pattern TheorySet,+    pattern TheoryFunction,+    pattern TheoryNumber,+    pattern TheorySymbol,++    theoryAtomsSize,+    theoryAtomsId,+    theoryAtomsTermType,+    theoryAtomsTermNumber,+    theoryAtomsTermName,+    theoryAtomsTermArguments,+    theoryAtomsTermToString,+    theoryAtomsElementTuple,+    theoryAtomsElementCondition,+    theoryAtomsElementConditionId,+    theoryAtomsElementToString,+    theoryAtomsAtomTerm,+    theoryAtomsAtomElements,+    theoryAtomsAtomHasGuard,+    theoryAtomsAtomGuard,+    theoryAtomsAtomLiteral,+    theoryAtomsAtomToString+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Text (Text, pack)+import Data.Bifunctor++import Numeric.Natural+import Foreign+import Foreign.C++import qualified Clingo.Raw as Raw+import Clingo.Internal.Types+import Clingo.Internal.Utils++newtype TermId = TermId Raw.Identifier+newtype ElementId = ElementId Raw.Identifier+newtype AtomId = AtomId Raw.Identifier++newtype TheoryTermType = TheoryTermType Raw.TheoryTermType++pattern TheoryTuple = TheoryTermType Raw.TheoryTuple+pattern TheoryList = TheoryTermType Raw.TheoryList+pattern TheorySet = TheoryTermType Raw.TheorySet+pattern TheoryFunction = TheoryTermType Raw.TheoryFunction+pattern TheoryNumber = TheoryTermType Raw.TheoryNumber+pattern TheorySymbol = TheoryTermType Raw.TheorySymbol++theoryAtomsTermType :: (MonadIO m, MonadThrow m) +                    => TheoryAtoms s -> TermId -> m TheoryTermType+theoryAtomsTermType (TheoryAtoms h) (TermId k) = TheoryTermType <$>+    marshall1 (Raw.theoryAtomsTermType h k)++theoryAtomsTermNumber :: (MonadIO m, MonadThrow m) +                      => TheoryAtoms s -> TermId -> m Integer+theoryAtomsTermNumber (TheoryAtoms h) (TermId k) = fromIntegral <$>+    marshall1 (Raw.theoryAtomsTermNumber h k)++theoryAtomsTermName :: (MonadIO m, MonadThrow m) +                    => TheoryAtoms s -> TermId -> m Text+theoryAtomsTermName (TheoryAtoms h) (TermId k) = pack <$> +    (liftIO . peekCString =<< marshall1 (Raw.theoryAtomsTermName h k))++theoryAtomsTermArguments :: (MonadIO m, MonadThrow m) +                         => TheoryAtoms s -> TermId -> m [TermId]+theoryAtomsTermArguments (TheoryAtoms h) (TermId k) = map TermId <$> marshall1A+    (Raw.theoryAtomsTermArguments h k)++theoryAtomsTermToString :: (MonadIO m, MonadThrow m) +                        => TheoryAtoms s -> TermId -> m Text+theoryAtomsTermToString (TheoryAtoms h) (TermId k) = do+    len <- marshall1 (Raw.theoryAtomsTermToStringSize h k)+    liftIO $ allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.theoryAtomsTermToString h k arr len)+        pack <$> peekCStringLen (arr, fromIntegral len)++theoryAtomsElementTuple :: (MonadIO m, MonadThrow m) +                        => TheoryAtoms s -> ElementId -> m [TermId]+theoryAtomsElementTuple (TheoryAtoms h) (ElementId k) = +    map TermId <$> marshall1A (Raw.theoryAtomsElementTuple h k)++theoryAtomsElementCondition :: (MonadIO m, MonadThrow m) +                            => TheoryAtoms s -> ElementId -> m [AspifLiteral s]+theoryAtomsElementCondition (TheoryAtoms h) (ElementId k) = +    map AspifLiteral <$> marshall1A (Raw.theoryAtomsElementCondition h k)++theoryAtomsElementConditionId :: (MonadIO m, MonadThrow m) +                              => TheoryAtoms s -> ElementId +                              -> m (AspifLiteral s)+theoryAtomsElementConditionId (TheoryAtoms h) (ElementId k) = AspifLiteral <$>+    marshall1 (Raw.theoryAtomsElementConditionId h k)++theoryAtomsElementToString :: (MonadIO m, MonadThrow m) +                           => TheoryAtoms s -> ElementId -> m Text+theoryAtomsElementToString (TheoryAtoms h) (ElementId k) = do+    len <- marshall1 (Raw.theoryAtomsElementToStringSize h k)+    liftIO $ allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.theoryAtomsElementToString h k arr len)+        pack <$> peekCStringLen (arr, fromIntegral len)++theoryAtomsSize :: (MonadIO m, MonadThrow m) => TheoryAtoms s -> m Natural+theoryAtomsSize (TheoryAtoms h) = +    fromIntegral <$> marshall1 (Raw.theoryAtomsSize h)++theoryAtomsId :: (MonadIO m, MonadThrow m) +              => TheoryAtoms s -> Natural -> m (Maybe AtomId)+theoryAtomsId h x = do+    lim <- theoryAtomsSize h+    return $ if x < lim then Just (AtomId (fromIntegral x)) else Nothing++theoryAtomsAtomTerm :: (MonadIO m, MonadThrow m) +                    => TheoryAtoms s -> AtomId -> m TermId+theoryAtomsAtomTerm (TheoryAtoms h) (AtomId k) = TermId <$> marshall1+    (Raw.theoryAtomsAtomTerm h k)++theoryAtomsAtomElements :: (MonadIO m, MonadThrow m) +                        => TheoryAtoms s -> AtomId -> m [ElementId]+theoryAtomsAtomElements (TheoryAtoms h) (AtomId k) = +    map ElementId <$> marshall1A (Raw.theoryAtomsAtomElements h k)++theoryAtomsAtomHasGuard :: (MonadIO m, MonadThrow m) +                        => TheoryAtoms s -> AtomId -> m Bool+theoryAtomsAtomHasGuard (TheoryAtoms h) (AtomId k) = toBool <$> marshall1+    (Raw.theoryAtomsAtomHasGuard h k)++theoryAtomsAtomGuard :: (MonadIO m, MonadThrow m) +                     => TheoryAtoms s -> AtomId -> m (Text, TermId)+theoryAtomsAtomGuard (TheoryAtoms h) (AtomId k) = bimap pack TermId <$> go+    where go = do+              (x,y) <- marshall2 $ Raw.theoryAtomsAtomGuard h k+              x' <- liftIO $ peekCString x+              return (x',y)++theoryAtomsAtomLiteral :: (MonadIO m, MonadThrow m) +                       => TheoryAtoms s -> AtomId -> m (AspifLiteral s)+theoryAtomsAtomLiteral (TheoryAtoms h) (AtomId k) = AspifLiteral <$> marshall1+    (Raw.theoryAtomsAtomLiteral h k)++theoryAtomsAtomToString :: (MonadIO m, MonadThrow m) +                        => TheoryAtoms s -> AtomId -> m Text+theoryAtomsAtomToString (TheoryAtoms h) (AtomId k) = do+    len <- marshall1 (Raw.theoryAtomsAtomToStringSize h k)+    liftIO $ allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.theoryAtomsAtomToString h k arr len)+        pack <$> peekCStringLen (arr, fromIntegral len)
+ src/Clingo/Internal/Propagation.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Internal.Propagation+(+    Assignment,+    Literal,++    -- * Propagation Handles and Types+    PropagateInit,+    PropagateCtrl,+    IOPropagator (..),+    PropagationStop (..),++    -- * Truth values+    TruthValue,+    pattern TruthFree,+    pattern TruthFalse,+    pattern TruthTrue,++    -- * Assignment+    decisionLevel,+    hasConflict,+    hasLiteral,+    levelOf,+    decision,+    isFixed,+    truthValue,++    -- * Clauses+    Clause (..),+    ClauseType (..),++    -- * Propagation+    assignment,+    addClause,+    addLiteral,+    addWatch,+    hasWatch,+    removeWatch,+    propagate,+    getThreadId,++    -- * Initialization+    initAddWatch,+    countThreads,+    solverLiteral,+    symbolicAtoms,+    theoryAtoms+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch++import Numeric.Natural++import Foreign++import qualified Clingo.Raw as Raw+import Clingo.Internal.Utils+import Clingo.Internal.Types++newtype Assignment s = Assignment Raw.Assignment++-- | Get the current decision level.+decisionLevel :: (MonadIO m) => Assignment s -> m Natural+decisionLevel (Assignment a) = fromIntegral <$> Raw.assignmentDecisionLevel a++-- | Determine whether assignment has a conflict.+hasConflict :: (MonadIO m) => Assignment s -> m Bool+hasConflict (Assignment a) = toBool <$> Raw.assignmentHasConflict a++-- | Determine whether a literal is part of an assignment.+hasLiteral :: (MonadIO m) => Assignment s -> Literal s -> m Bool+hasLiteral (Assignment a) lit = toBool <$> Raw.assignmentHasLiteral a +                                           (rawLiteral lit)++-- | Find the decision level of a given literal in an assignment.+levelOf :: (MonadIO m, MonadThrow m) => Assignment s -> Literal s -> m Natural+levelOf (Assignment a) lit = fromIntegral <$> marshall1 go+    where go = Raw.assignmentLevel a (rawLiteral lit)++-- | Determine the decision literal given a decision level.+decision :: (MonadIO m, MonadThrow m) +         => Assignment s -> Natural -> m (Literal s)+decision (Assignment a) level = Literal <$> marshall1 go+    where go = Raw.assignmentDecision a (fromIntegral level)++-- | Check if a literal has a fixed truth value.+isFixed :: (MonadIO m, MonadThrow m) => Assignment s -> Literal s -> m Bool+isFixed (Assignment a) lit = toBool <$> marshall1 go+    where go = Raw.assignmentIsFixed a (rawLiteral lit)++-- | Obtain the truth value of a literal+truthValue :: (MonadIO m, MonadThrow m) +           => Assignment s -> Literal s -> m TruthValue+truthValue (Assignment a) lit = TruthValue <$> marshall1 go+    where go = Raw.assignmentTruthValue a (rawLiteral lit)++data Clause s = Clause [Literal s] ClauseType+    deriving (Show)++data ClauseType = ClauseLearnt +                | ClauseVolatile Bool       -- ^ Bool determines static+                | ClauseStatic+    deriving (Eq, Show, Ord)++rawClauseType :: ClauseType -> Raw.ClauseType+rawClauseType c = case c of+    ClauseLearnt -> Raw.ClauseLearnt+    ClauseStatic -> Raw.ClauseStatic+    ClauseVolatile static -> if static then Raw.ClauseVolatileStatic+                                       else Raw.ClauseVolatile++data PropagationStop = Continue | Stop+    deriving (Eq, Show, Ord, Read, Enum, Bounded)++pstopFromBool :: Bool -> PropagationStop+pstopFromBool True = Continue+pstopFromBool False = Stop++addClause :: (MonadIO m, MonadThrow m)+          => PropagateCtrl s -> Clause s -> m PropagationStop+addClause (PropagateCtrl c) (Clause ls t) = pstopFromBool . toBool <$> +    marshall1 go+    where go x = withArrayLen (map rawLiteral ls) $ \len arr ->+                     Raw.propagateControlAddClause c arr (fromIntegral len)+                                                   (rawClauseType t) x++addLiteral :: (MonadIO m, MonadThrow m)+           => PropagateCtrl s -> m (Literal s)+addLiteral (PropagateCtrl c) = Literal <$> marshall1 +    (Raw.propagateControlAddLiteral c)++getThreadId :: MonadIO m => PropagateCtrl s -> m Integer+getThreadId (PropagateCtrl c) = fromIntegral <$> Raw.propagateControlThreadId c++addWatch :: (MonadIO m, MonadThrow m) => PropagateCtrl s -> Literal s -> m ()+addWatch (PropagateCtrl c) lit = +    marshall0 (Raw.propagateControlAddWatch c (rawLiteral lit))++hasWatch :: (MonadIO m) => PropagateCtrl s -> Literal s -> m Bool+hasWatch (PropagateCtrl c) lit = +    toBool <$> Raw.propagateControlHasWatch c (rawLiteral lit)++removeWatch :: (MonadIO m) => PropagateCtrl s -> Literal s -> m ()+removeWatch (PropagateCtrl c) lit =+    Raw.propagateControlRemoveWatch c (rawLiteral lit)++propagate :: (MonadIO m, MonadThrow m) => PropagateCtrl s -> m PropagationStop+propagate (PropagateCtrl c) = pstopFromBool . toBool <$>+    marshall1 (Raw.propagateControlPropagate c)++assignment :: (MonadIO m) => PropagateCtrl s -> m (Assignment s)+assignment (PropagateCtrl c) = Assignment <$> Raw.propagateControlAssignment c++initAddWatch :: (MonadIO m, MonadThrow m) +             => PropagateInit s -> Literal s -> m ()+initAddWatch (PropagateInit c) lit = +    marshall0 (Raw.propagateInitAddWatch c (rawLiteral lit))++countThreads :: MonadIO m => PropagateInit s -> m Integer+countThreads (PropagateInit c) = fromIntegral <$> +    Raw.propagateInitNumberOfThreads c++solverLiteral :: (MonadIO m, MonadThrow m) +              => PropagateInit s -> AspifLiteral s -> m (Literal s)+solverLiteral (PropagateInit c) lit = Literal <$> marshall1+    (Raw.propagateInitSolverLiteral c (rawAspifLiteral lit))++symbolicAtoms :: (MonadIO m, MonadThrow m)+              => PropagateInit s -> m (SymbolicAtoms s)+symbolicAtoms (PropagateInit c) = SymbolicAtoms <$> marshall1+    (Raw.propagateInitSymbolicAtoms c)++theoryAtoms :: (MonadIO m, MonadThrow m)+              => PropagateInit s -> m (TheoryAtoms s)+theoryAtoms (PropagateInit c) = TheoryAtoms <$> marshall1+    (Raw.propagateInitTheoryAtoms c)
+ src/Clingo/Internal/Statistics.hs view
@@ -0,0 +1,98 @@+-- | A module providing direct, but memory managed and somewhat safe, access to+-- the Clingo statistics interface. The preferred way to interface with the+-- statistics is the tree based interface in 'Clingo.Statistics'. This interface+-- exists solely for users who want to provide their own abstraction, without+-- having to reimplement memory management for the raw versions in+-- 'Clingo.Raw.Statistics'.+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Internal.Statistics+(+    Statistics,+    StatisticsType,+    pattern StatsEmpty,+    pattern StatsValue,+    pattern StatsArray,+    pattern StatsMap,+    SKey,++    statisticsRoot,+    statisticsType,++    -- ** Array Access+    statisticsArraySize,+    statisticsArrayAt,++    -- ** Map Access+    statisticsMapSize,+    statisticsMapSubkeyName,+    statisticsMapAt,++    -- ** Value Access+    statisticsValueGet+)+where++import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.Text (Text, pack, unpack)++import Numeric.Natural++import Foreign+import Foreign.C++import qualified Clingo.Raw as Raw+import Clingo.Internal.Types+import Clingo.Internal.Utils++newtype SKey = SKey Word64+    deriving (Show, Eq, Ord)++statisticsRoot :: (MonadIO m, MonadThrow m) => Statistics s -> m SKey+statisticsRoot (Statistics s) = +    SKey <$> marshall1 (Raw.statisticsRoot s)++newtype StatisticsType = StatisticsType Raw.StatisticsType++pattern StatsEmpty = StatisticsType Raw.StatsEmpty+pattern StatsValue = StatisticsType Raw.StatsValue+pattern StatsArray = StatisticsType Raw.StatsArray+pattern StatsMap = StatisticsType Raw.StatsMap++statisticsType :: (MonadIO m, MonadThrow m) +               => Statistics s -> SKey -> m StatisticsType+statisticsType (Statistics s) (SKey k) = +    StatisticsType <$> marshall1 (Raw.statisticsType s k)++statisticsArraySize :: (MonadIO m, MonadThrow m) +                    => Statistics s -> SKey -> m Natural+statisticsArraySize (Statistics s) (SKey k) = +    fromIntegral <$> marshall1 (Raw.statisticsArraySize s k)++statisticsArrayAt :: (MonadIO m, MonadThrow m)+                  => Statistics s -> SKey -> Natural -> m SKey+statisticsArrayAt (Statistics s) (SKey k) offset =+    SKey <$> marshall1 (Raw.statisticsArrayAt s k (fromIntegral offset))++statisticsMapSize :: (MonadIO m, MonadThrow m)+                  => Statistics s -> SKey -> m Natural+statisticsMapSize (Statistics s) (SKey k) =+    fromIntegral <$> marshall1 (Raw.statisticsMapSize s k)++statisticsMapSubkeyName :: (MonadIO m, MonadThrow m)+                        => Statistics s -> SKey -> Natural -> m Text+statisticsMapSubkeyName (Statistics s) (SKey k) offset = do+    cstr <- marshall1 (Raw.statisticsMapSubkeyName s k (fromIntegral offset))+    pack <$> liftIO (peekCString cstr)++statisticsMapAt :: (MonadIO m, MonadThrow m)+                => Statistics s -> SKey -> Text -> m SKey+statisticsMapAt (Statistics s) (SKey k) name =+    SKey <$> marshall1 go+    where go = withCString (unpack name) . flip (Raw.statisticsMapAt s k)++statisticsValueGet :: (MonadIO m, MonadThrow m) +                   => Statistics s -> SKey -> m Double+statisticsValueGet (Statistics s) (SKey k) = +    realToFrac <$> marshall1 (Raw.statisticsValueGet s k)
+ src/Clingo/Internal/Symbol.hs view
@@ -0,0 +1,173 @@+module Clingo.Internal.Symbol+(+    pureSymbol,+    symbolHash',+    symbolNumber',+    symbolName',+    symbolString',+    symbolArguments',+    prettySymbol',++    pureSignature,+    signatureArity',+    signatureHash',+    signatureName',++    createSignature',+    createNumber',+    createSupremum',+    createInfimum',+    createString',+    createFunction',++    MonadSymbol (..),+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch++import Data.Text (Text, pack, unpack)+import Numeric.Natural+import Foreign.C+import Foreign++import Clingo.Internal.Types+import Clingo.Internal.Utils+import qualified Clingo.Raw as Raw++pureSymbol :: (MonadIO m, MonadThrow m) => Raw.Symbol -> m (Symbol s)+pureSymbol s = Symbol+    <$> pure s+    <*> pure (Raw.symbolType s)+    <*> pure (symbolHash' s)+    <*> symbolNumber' s+    <*> symbolName' s+    <*> symbolString' s+    <*> symbolArguments' s+    <*> prettySymbol' s++symbolHash' :: Raw.Symbol -> Integer+symbolHash' = fromIntegral . Raw.symbolHash++symbolNumber' :: (MonadIO m) => Raw.Symbol -> m (Maybe Integer)+symbolNumber' s = case Raw.symbolType s of+    Raw.SymNumber -> fmap fromIntegral <$> marshall1RT (Raw.symbolNumber s)+    _ -> return Nothing++symbolName' :: (MonadIO m) => Raw.Symbol -> m (Maybe Text)+symbolName' s = case Raw.symbolType s of+    Raw.SymFunction -> do+        x <- marshall1RT (Raw.symbolName s)+        case x of+            Nothing   -> return Nothing+            Just cstr -> liftIO $ (Just . pack) <$> peekCString cstr+    _ -> return Nothing++symbolString' :: (MonadIO m) => Raw.Symbol -> m (Maybe Text)+symbolString' s = case Raw.symbolType s of+    Raw.SymString -> do+        x <- marshall1RT (Raw.symbolString s)+        case x of+            Nothing   -> return Nothing+            Just cstr -> liftIO $ (Just . pack) <$> peekCString cstr+    _ -> return Nothing++symbolArguments' :: (MonadIO m, MonadThrow m) => Raw.Symbol -> m [Symbol s]+symbolArguments' s = case Raw.symbolType s of+    Raw.SymFunction -> mapM pureSymbol =<< marshall1A (Raw.symbolArguments s)+    _ -> return []++prettySymbol' :: (MonadIO m, MonadThrow m) => Raw.Symbol -> m Text+prettySymbol' s = do+    len <- marshall1 (Raw.symbolToStringSize s)+    str <- liftIO $ allocaArray (fromIntegral len) $ \ptr -> do+        b <- Raw.symbolToString s ptr len+        x <- peekCString ptr+        checkAndThrow b+        return x+    return (pack str)++pureSignature :: MonadIO m => Raw.Signature -> m (Signature s)+pureSignature s = Signature+    <$> pure s+    <*> pure (signatureArity' s)+    <*> signatureName' s+    <*> pure (signatureHash' s)++signatureName' :: MonadIO m => Raw.Signature -> m Text+signatureName' s = liftIO $+    pack <$> (peekCString . Raw.signatureName $ s)++signatureArity' :: Raw.Signature -> Natural+signatureArity' = fromIntegral . Raw.signatureArity++signatureHash' :: Raw.Signature -> Integer+signatureHash' = fromIntegral . Raw.symbolHash++createSignature' :: (MonadIO m, MonadThrow m)+                 => Text                     -- ^ Name+                 -> Natural                  -- ^ Arity+                 -> Bool                     -- ^ Positive+                 -> m (Signature s)+createSignature' name arity pos = pureSignature =<< marshall1 go+    where go x = withCString (unpack name) $ \cstr ->+                     Raw.signatureCreate cstr (fromIntegral arity) +                                         (fromBool pos) x++createNumber' :: (MonadIO m, MonadThrow m, Integral a) => a -> m (Symbol s)+createNumber' a = pureSymbol =<< +    marshall1V (Raw.symbolCreateNumber (fromIntegral a))++createSupremum' :: (MonadIO m, MonadThrow m) => m (Symbol s)+createSupremum' = pureSymbol =<< marshall1V Raw.symbolCreateSupremum++createInfimum' :: (MonadIO m, MonadThrow m) => m (Symbol s)+createInfimum' = pureSymbol =<< marshall1V Raw.symbolCreateInfimum++createString' :: (MonadIO m, MonadThrow m) => Text -> m (Symbol s)+createString' str = pureSymbol =<< marshall1 go+    where go = withCString (unpack str) . flip Raw.symbolCreateString++createFunction' :: (MonadIO m, MonadThrow m)+                => Text          -- ^ Function name+                -> [Symbol s]    -- ^ Arguments+                -> Bool          -- ^ Positive sign+                -> m (Symbol s)+createFunction' name args pos = pureSymbol =<< marshall1 go +    where go x = withCString (unpack name) $ \cstr -> +                     withArrayLen (map rawSymbol args) $ \len syms -> +                         Raw.symbolCreateFunction cstr syms +                             (fromIntegral len) (fromBool pos) x++class MonadSymbol m where+    -- | Create a new signature with the solver, taking a name, an arity and a+    -- bool determining the sign.+    createSignature :: Text -> Natural -> Bool -> m s (Signature s)+    -- | Create a number symbol.+    createNumber :: (Integral a) => a -> m s (Symbol s)+    -- | Create a supremum symbol, @#sup@.+    createSupremum :: m s (Symbol s)+    -- | Create a infimum symbol, @#inf@.+    createInfimum :: m s (Symbol s)+    -- | Construct a symbol representing a string.+    createString :: Text -> m s (Symbol s)+    -- | Construct a symbol representing a function or tuple from a name,+    -- arguments, and whether the sign is positive.+    createFunction :: Text -> [Symbol s] -> Bool -> m s (Symbol s)++instance MonadSymbol IOSym where+    createSignature = createSignature'+    createNumber = createNumber'+    createSupremum = createSupremum'+    createInfimum = createInfimum'+    createString = createString'+    createFunction = createFunction'++instance MonadSymbol Clingo where+    createSignature = createSignature'+    createNumber = createNumber'+    createSupremum = createSupremum'+    createInfimum = createInfimum'+    createString = createString'+    createFunction = createFunction'
+ src/Clingo/Internal/Types.hs view
@@ -0,0 +1,416 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Internal.Types+(+    IOSym (..),+    Clingo (..),+    runClingo,+    askC,+    Signed (..),+    Symbol (..),+    Signature (..),+    SymbolicLiteral (..),+    rawSymLit,+    Literal (..),+    WeightedLiteral (..),+    rawWeightedLiteral,+    fromRawWeightedLiteral,+    ExternalType (..),+    rawExtT,+    fromRawExtT,+    HeuristicType (..),+    rawHeuT,+    fromRawHeuT,+    negateLiteral,+    AspifLiteral (..),+    Atom (..),+    Model (..),+    Location (..),+    rawLocation,+    freeRawLocation,+    fromRawLocation,+    SolveResult (..),+    rawSolveResult,+    fromRawSolveResult,+    SolveMode (..),+    fromRawSolveMode,+    pattern SolveModeAsync,+    pattern SolveModeYield,+    Solver (..),+    exhausted,+    wrapCBLogger,+    Statistics (..),+    ProgramBuilder (..),+    Configuration (..),+    Backend (..),+    SymbolicAtoms (..),+    TheoryAtoms (..),+    TruthValue (..),+    pattern TruthFree,+    pattern TruthFalse,+    pattern TruthTrue,+    negateTruth,+    IOPropagator (..),+    rawPropagator,+    PropagateCtrl (..),+    PropagateInit (..),+    AMVTree (..)+)+where++import Control.DeepSeq+import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Reader+import Control.Monad.Catch+import Data.Text (Text, pack)+import Data.Bits+import Data.Hashable+import Foreign+import Foreign.C+import GHC.Generics+import qualified Clingo.Raw as Raw+import Clingo.Internal.Utils+import Numeric.Natural++-- | A monad that serves as witness that data registered with a running solver+-- still exists and can be used.+newtype IOSym s a = IOSym { iosym :: IO a }+    deriving (Functor, Applicative, Monad, MonadMask, MonadThrow+             , MonadCatch, MonadIO, MonadFix, MonadPlus, Alternative )++-- | The 'Clingo' monad provides a base monad for computations utilizing the+-- clingo answer set solver. It uses an additional type parameter to ensure that+-- values that are managed by the solver can not leave scope. +newtype Clingo s a = Clingo { clingo :: ReaderT Raw.Control (IOSym s) a }+    deriving (Functor, Applicative, Monad, MonadMask, MonadThrow+             , MonadCatch, MonadIO, MonadFix, MonadPlus, Alternative)++-- | Run a clingo computation from an explicit handle. The handle must be+-- cleaned up manually afterwards, or on failure!+runClingo :: Raw.Control -> Clingo s a -> IO a+runClingo ctrl a = iosym (runReaderT (clingo a) ctrl)++-- | Get the control handle from the 'Clingo' monad. Arbitrarily unsafe things+-- can be done with this!+askC :: Clingo s Raw.Control+askC = Clingo ask++data Symbol s = Symbol +    { rawSymbol :: Raw.Symbol +    , symType   :: Raw.SymbolType+    , symHash   :: Integer+    , symNum    :: Maybe Integer+    , symName   :: Maybe Text+    , symString :: Maybe Text+    , symArgs   :: [Symbol s]+    , symPretty :: Text+    }+    deriving (Generic)++instance NFData (Symbol s)++instance Eq (Symbol s) where+    a == b = toBool (Raw.symbolIsEqualTo (rawSymbol a) (rawSymbol b))++instance Ord (Symbol s) where+    a <= b = toBool (Raw.symbolIsLessThan (rawSymbol a) (rawSymbol b))++instance Hashable (Symbol s) where+    hashWithSalt s sym = hashWithSalt s (symHash sym)++class Signed a where+    positive :: a -> Bool+    positive = not . negative++    negative :: a -> Bool+    negative = not . positive++instance Signed Bool where+    positive x = x++data SymbolicLiteral s +    = SLPositive (Symbol s)+    | SLNegative (Symbol s)+    deriving (Generic, Eq, Ord)++instance Hashable (SymbolicLiteral s)++symLitSymbol :: SymbolicLiteral s -> Symbol s+symLitSymbol (SLPositive s) = s+symLitSymbol (SLNegative s) = s++symLitPositive :: SymbolicLiteral s -> Bool+symLitPositive (SLPositive _) = True+symLitPositive _ = False++instance Signed (SymbolicLiteral s) where+    positive = symLitPositive++rawSymLit :: SymbolicLiteral s -> Raw.SymbolicLiteral+rawSymLit sl = Raw.SymbolicLiteral+    { Raw.slitSymbol   = rawSymbol (symLitSymbol sl)+    , Raw.slitPositive = fromBool (symLitPositive sl) }++data Signature s = Signature +    { rawSignature :: Raw.Signature+    , sigArity     :: Natural+    , sigName      :: Text +    , sigHash      :: Integer+    }++instance Eq (Signature s) where+    a == b = toBool (Raw.signatureIsEqualTo (rawSignature a) (rawSignature b))++instance Ord (Signature s) where+    a <= b = toBool (Raw.signatureIsLessThan (rawSignature a) (rawSignature b))++instance Signed (Signature s) where+    positive = toBool . Raw.signatureIsPositive . rawSignature+    negative = toBool . Raw.signatureIsNegative . rawSignature++instance Hashable (Signature s) where+    hashWithSalt s sig = hashWithSalt s (sigHash sig)++newtype Literal s = Literal { rawLiteral :: Raw.Literal }+    deriving (Ord, Show, Eq, NFData, Generic)++instance Hashable (Literal s)++instance Signed (Literal s) where+    positive = (> 0) . rawLiteral+    negative = (< 0) . rawLiteral++data WeightedLiteral s = WeightedLiteral (Literal s) Integer+    deriving (Eq, Show, Ord, Generic)++instance Hashable (WeightedLiteral s)+instance NFData (WeightedLiteral s)++rawWeightedLiteral :: WeightedLiteral s -> Raw.WeightedLiteral+rawWeightedLiteral (WeightedLiteral l w) = +    Raw.WeightedLiteral (rawLiteral l) (fromIntegral w)++fromRawWeightedLiteral :: Raw.WeightedLiteral -> WeightedLiteral s+fromRawWeightedLiteral (Raw.WeightedLiteral l w) = +    WeightedLiteral (Literal l) (fromIntegral w)++data ExternalType = ExtFree | ExtTrue | ExtFalse | ExtRelease+    deriving (Show, Eq, Ord, Enum, Read, Generic)++instance Hashable ExternalType++rawExtT :: ExternalType -> Raw.ExternalType+rawExtT ExtFree = Raw.ExternalFree+rawExtT ExtTrue = Raw.ExternalTrue+rawExtT ExtFalse = Raw.ExternalFalse+rawExtT ExtRelease = Raw.ExternalRelease++fromRawExtT :: Raw.ExternalType -> ExternalType+fromRawExtT Raw.ExternalFree = ExtFree+fromRawExtT Raw.ExternalTrue = ExtTrue+fromRawExtT Raw.ExternalFalse = ExtFalse+fromRawExtT Raw.ExternalRelease = ExtRelease+fromRawExtT _ = error "unknown external_type"++data HeuristicType = HeuristicLevel | HeuristicSign | HeuristicFactor +                   | HeuristicInit  | HeuristicTrue | HeuristicFalse+    deriving (Show, Eq, Ord, Enum, Read, Generic)++instance Hashable HeuristicType++rawHeuT :: HeuristicType -> Raw.HeuristicType+rawHeuT HeuristicLevel = Raw.HeuristicLevel+rawHeuT HeuristicSign = Raw.HeuristicSign+rawHeuT HeuristicFactor = Raw.HeuristicFactor+rawHeuT HeuristicInit = Raw.HeuristicInit+rawHeuT HeuristicTrue = Raw.HeuristicTrue+rawHeuT HeuristicFalse = Raw.HeuristicFalse++fromRawHeuT :: Raw.HeuristicType -> HeuristicType+fromRawHeuT Raw.HeuristicLevel = HeuristicLevel+fromRawHeuT Raw.HeuristicSign = HeuristicSign+fromRawHeuT Raw.HeuristicFactor = HeuristicFactor+fromRawHeuT Raw.HeuristicInit = HeuristicInit+fromRawHeuT Raw.HeuristicTrue = HeuristicTrue+fromRawHeuT Raw.HeuristicFalse = HeuristicFalse+fromRawHeuT _ = error "unknown heuristic_type"++negateLiteral :: Literal s -> Literal s+negateLiteral (Literal a) = Literal (negate a)++newtype AspifLiteral s = AspifLiteral { rawAspifLiteral :: Raw.Literal }+    deriving (Ord, Show, Eq, NFData, Generic)++instance Hashable (AspifLiteral s)++instance Signed (AspifLiteral s) where+    positive = (> 0) . rawAspifLiteral+    negative = (< 0) . rawAspifLiteral++newtype Atom s = Atom { rawAtom :: Raw.Atom }+    deriving (Show, Ord, Eq, NFData, Generic)++instance Hashable (Atom s)++newtype Model s = Model Raw.Model++data Location = Location+    { locBeginFile :: FilePath+    , locEndFile   :: FilePath+    , locBeginLine :: Natural+    , locEndLine   :: Natural+    , locBeginCol  :: Natural+    , locEndCol    :: Natural }+    deriving (Eq, Show, Ord)++rawLocation :: Location -> IO Raw.Location+rawLocation l = Raw.Location +    <$> newCString (locBeginFile l)+    <*> newCString (locEndFile l)+    <*> pure (fromIntegral (locBeginLine l))+    <*> pure (fromIntegral (locEndLine l))+    <*> pure (fromIntegral (locBeginCol l))+    <*> pure (fromIntegral (locEndCol l))++freeRawLocation :: Raw.Location -> IO ()+freeRawLocation l = do+    free (Raw.locBeginFile l)+    free (Raw.locEndFile l)++fromRawLocation :: Raw.Location -> IO Location+fromRawLocation l = Location+    <$> peekCString (Raw.locBeginFile l)+    <*> peekCString (Raw.locEndFile l)+    <*> pure (fromIntegral . Raw.locBeginLine $ l)+    <*> pure (fromIntegral . Raw.locEndLine $ l)+    <*> pure (fromIntegral . Raw.locBeginCol $ l)+    <*> pure (fromIntegral . Raw.locEndCol $ l)++data SolveResult = Satisfiable Bool | Unsatisfiable Bool | Interrupted+    deriving (Eq, Show, Read, Generic)++instance NFData SolveResult+instance Hashable SolveResult++exhausted :: SolveResult -> Bool+exhausted (Satisfiable b) = b+exhausted (Unsatisfiable b) = b+exhausted _ = False++rawSolveResult :: SolveResult -> Raw.SolveResult+rawSolveResult (Satisfiable e) =+    Raw.ResultSatisfiable .|. if e then Raw.ResultExhausted else zeroBits+rawSolveResult (Unsatisfiable e) =+    Raw.ResultUnsatisfiable .|. if e then Raw.ResultExhausted else zeroBits+rawSolveResult Interrupted = Raw.ResultInterrupted++fromRawSolveResult :: Raw.SolveResult -> SolveResult+fromRawSolveResult r+    | r == Raw.ResultSatisfiable .|. Raw.ResultExhausted = Satisfiable True+    | r == Raw.ResultSatisfiable = Satisfiable False+    | r == Raw.ResultUnsatisfiable .|. Raw.ResultExhausted = Unsatisfiable True+    | r == Raw.ResultUnsatisfiable = Unsatisfiable False+    | r == Raw.ResultInterrupted = Interrupted+    | otherwise = error "Malformed clingo_solve_result_bitset_t"++newtype SolveMode = SolveMode { rawSolveMode :: Raw.SolveMode }+    deriving (Eq, Show, Read, Ord)++fromRawSolveMode :: Raw.SolveMode -> SolveMode+fromRawSolveMode = SolveMode++newtype Solver s = Solver Raw.SolveHandle++pattern SolveModeAsync = SolveMode Raw.SolveModeAsync+pattern SolveModeYield = SolveMode Raw.SolveModeYield++wrapCBLogger :: MonadIO m+             => (ClingoWarning -> Text -> IO ())+             -> m (FunPtr (Raw.Logger ()))+wrapCBLogger f = liftIO $ Raw.mkCallbackLogger go+    where go :: Raw.ClingoWarning -> CString -> Ptr () -> IO ()+          go w str _ = peekCString str >>= \cstr ->+                           f (ClingoWarning w) (pack cstr)++newtype Statistics s = Statistics Raw.Statistics++newtype ProgramBuilder s = ProgramBuilder Raw.ProgramBuilder++newtype Configuration s = Configuration Raw.Configuration++newtype Backend s = Backend Raw.Backend++newtype SymbolicAtoms s = SymbolicAtoms Raw.SymbolicAtoms++newtype TheoryAtoms s = TheoryAtoms Raw.TheoryAtoms++newtype TruthValue = TruthValue { rawTruthValue :: Raw.TruthValue }+    deriving (Eq, Show, Ord)++pattern TruthFree = TruthValue Raw.TruthFree+pattern TruthFalse = TruthValue Raw.TruthFalse+pattern TruthTrue = TruthValue Raw.TruthTrue++negateTruth :: TruthValue -> TruthValue+negateTruth TruthFree = TruthFree+negateTruth TruthTrue = TruthFalse+negateTruth TruthFalse = TruthTrue+negateTruth _ = error "negateTruth: Invalid TruthValue"++data IOPropagator s = IOPropagator+    { propagatorInit      :: Maybe (PropagateInit s -> IO ())+    , propagatorPropagate :: Maybe (PropagateCtrl s -> [Literal s] -> IO ())+    , propagatorUndo      :: Maybe (PropagateCtrl s -> [Literal s] -> IO ())+    , propagatorCheck     :: Maybe (PropagateCtrl s -> IO ())+    }++rawPropagator :: MonadIO m => IOPropagator s -> m (Raw.Propagator ())+rawPropagator p = Raw.Propagator <$> wrapCBInit (propagatorInit p)+                                 <*> wrapCBProp (propagatorPropagate p)+                                 <*> wrapCBUndo (propagatorUndo p)+                                 <*> wrapCBCheck (propagatorCheck p)++wrapCBInit :: MonadIO m+           => Maybe (PropagateInit s -> IO ())+           -> m (FunPtr (Raw.CallbackPropagatorInit ()))+wrapCBInit Nothing  = pure nullFunPtr+wrapCBInit (Just f) = liftIO $ Raw.mkCallbackPropagatorInit go+    where go :: Raw.PropagateInit -> Ptr () -> IO Raw.CBool+          go c _ = reraiseIO $ f (PropagateInit c)++wrapCBProp :: MonadIO m+           => Maybe (PropagateCtrl s -> [Literal s] -> IO ())+           -> m (FunPtr (Raw.CallbackPropagatorPropagate ()))+wrapCBProp Nothing  = pure nullFunPtr+wrapCBProp (Just f) = liftIO $ Raw.mkCallbackPropagatorPropagate go+    where go :: Raw.PropagateControl -> Ptr Raw.Literal -> CSize -> Ptr () +             -> IO Raw.CBool+          go c lits len _ = +              reraiseIO $ do+                  ls <- map Literal <$> peekArray (fromIntegral len) lits+                  f (PropagateCtrl c) ls++wrapCBUndo :: MonadIO m+           => Maybe (PropagateCtrl s -> [Literal s] -> IO ())+           -> m (FunPtr (Raw.CallbackPropagatorUndo ()))+wrapCBUndo = wrapCBProp++wrapCBCheck :: MonadIO m+            => Maybe (PropagateCtrl s -> IO ())+            -> m (FunPtr (Raw.CallbackPropagatorCheck ()))+wrapCBCheck Nothing  = pure nullFunPtr+wrapCBCheck (Just f) = liftIO $ Raw.mkCallbackPropagatorCheck go+    where go :: Raw.PropagateControl -> Ptr () -> IO Raw.CBool+          go c _ = reraiseIO $ f (PropagateCtrl c)++newtype PropagateCtrl s = PropagateCtrl Raw.PropagateControl++newtype PropagateInit s = PropagateInit Raw.PropagateInit++class AMVTree t where+    atArray :: Int -> t v -> Maybe (t v)+    atMap   :: Text -> t v -> Maybe (t v)+    value   :: t v -> Maybe v
+ src/Clingo/Internal/Utils.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}+module Clingo.Internal.Utils+(+    ClingoException,+    getException,+    ClingoWarning (..),+    warningString,++    checkAndThrow,+    marshall0,+    marshall1,+    marshall1V,+    marshall1A,+    marshall1RT,+    marshall2,+    marshall3V,+    reraiseIO+)+where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Typeable+import Data.Text (Text, pack)++import Foreign+import Foreign.C++import qualified Clingo.Raw as Raw++data ClingoException = ClingoException Raw.ClingoError String+    deriving (Show, Typeable)++instance Exception ClingoException++newtype ClingoWarning = ClingoWarning Raw.ClingoWarning+    deriving (Show, Typeable)++instance Exception ClingoWarning+    +getException :: MonadIO m => m ClingoException+getException = liftIO $ do+    code <- Raw.errorCode+    estr <- peekCString =<< Raw.errorString code+    return $ ClingoException code estr+{-# INLINE getException #-}++warningString :: MonadIO m => ClingoWarning -> m Text+warningString (ClingoWarning w) = liftIO $+    Raw.warningString w >>= fmap pack . peekCString++checkAndThrow :: (MonadIO m, MonadThrow m) => Raw.CBool -> m ()+checkAndThrow b = unless (toBool b) $ getException >>= throwM+{-# INLINE checkAndThrow #-}++checkAndThrowRT :: (MonadIO m, MonadThrow m) +                => m a -> Raw.CBool -> m (Maybe a)+checkAndThrowRT a b+    | toBool b = Just <$> a+    | otherwise = do+        exc <- getException+        case exc of+            ClingoException Raw.ErrorRuntime _ -> return Nothing+            _ -> throwM exc+{-# INLINE checkAndThrowRT #-}++marshall0 :: (MonadIO m, MonadThrow m) => IO Raw.CBool -> m ()+marshall0 action = liftIO action >>= checkAndThrow+{-# INLINE marshall0 #-}++marshall1 :: (Storable a, MonadIO m, MonadThrow m) +          => (Ptr a -> IO Raw.CBool) -> m a+marshall1 action = do+    (res, a) <- liftIO $ alloca $ \ptr -> do+        res <- action ptr+        a <- peek ptr+        return (res, a)+    checkAndThrow res+    return a+{-# INLINE marshall1 #-}++marshall1V :: (Storable a, MonadIO m) +           => (Ptr a -> IO ()) -> m a+marshall1V action =+    liftIO $ alloca $ \ptr -> do+        _ <- action ptr+        peek ptr+{-# INLINE marshall1V #-}++marshall1RT :: (Storable a, MonadIO m)+            => (Ptr a -> IO Raw.CBool) -> m (Maybe a)+marshall1RT action =+    liftIO $ alloca $ \ptr -> do+        res <- action ptr+        checkAndThrowRT (peek ptr) res+{-# INLINE marshall1RT #-}++marshall2 :: (Storable a, Storable b, MonadIO m, MonadThrow m)+          => (Ptr a -> Ptr b -> IO Raw.CBool) -> m (a,b)+marshall2 action = do+    (res, (a,b)) <- liftIO $ alloca $ \ptr1 -> +        alloca $ \ptr2 -> do+            res <- action ptr1 ptr2+            a <- peek ptr1+            b <- peek ptr2+            return (res, (a,b))+    checkAndThrow res+    return (a,b)+{-# INLINE marshall2 #-}++marshall1A :: (Storable a, MonadIO m, MonadThrow m)+           => (Ptr (Ptr a) -> Ptr CSize -> IO Raw.CBool) -> m [a]+marshall1A action = do+    (res, as) <- liftIO $ alloca $ \ptr1 -> +        alloca $ \ptr2 -> do+            res  <- action ptr1 ptr2+            len  <- peek ptr2+            arrp <- peek ptr1+            arr  <- peekArray (fromIntegral len) arrp+            return (res, arr)+    checkAndThrow res+    return as+{-# INLINE marshall1A #-}++marshall3V :: (Storable a, Storable b, Storable c, MonadIO m)+           => (Ptr a -> Ptr b -> Ptr c -> IO ()) -> m (a,b,c)+marshall3V action = do+    (a,b,c) <- liftIO $ alloca $ \ptr1 -> +        alloca $ \ptr2 -> +            alloca $ \ptr3 -> do+                _ <- action ptr1 ptr2 ptr3+                a <- peek ptr1+                b <- peek ptr2+                c <- peek ptr3+                return (a,b,c)+    return (a,b,c)+{-# INLINE marshall3V #-}++reraiseIO :: IO a -> IO Raw.CBool+reraiseIO action = catch (action >> return (fromBool True)) $ +    \(ClingoException e s) -> do+        withCString s $ Raw.setError e+        return (fromBool False)+{-# INLINE reraiseIO #-}
+ src/Clingo/Model.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Model+(+    Model,+    SolveControl,+    SymbolicLiteral,+    SymbolSelection (..),++    ModelType,+    pattern StableModel,+    pattern BraveConsequences,+    pattern CautiousConsequences,++    selectAll,+    selectNone,++    MonadModel (..)+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Foldable+import Foreign++import Numeric.Natural++import qualified Clingo.Raw as Raw+import Clingo.Internal.Symbol+import Clingo.Internal.Types+import Clingo.Internal.Utils++newtype SolveControl s = SolveControl Raw.SolveControl++newtype ModelType = ModelType Raw.ModelType++pattern StableModel = ModelType Raw.StableModel+pattern BraveConsequences = ModelType Raw.BraveConsequences+pattern CautiousConsequences = ModelType Raw.CautiousConsequences++-- | Type for building symbol selections.+data SymbolSelection = SymbolSelection +    { selectCSP     :: Bool+    , selectShown   :: Bool+    , selectAtoms   :: Bool+    , selectTerms   :: Bool+    , selectExtra   :: Bool+    , useComplement :: Bool }+    deriving (Eq, Show, Read, Ord)++selectAll :: SymbolSelection+selectAll = SymbolSelection True True True True True False++rawSymbolSelection :: SymbolSelection -> Raw.ShowFlag+rawSymbolSelection s = foldr ((.|.) . fst) zeroBits . filter snd $+    [ (Raw.ShowCSP, selectCSP s)+    , (Raw.ShowShown, selectShown s)+    , (Raw.ShowAtoms, selectAtoms s)+    , (Raw.ShowTerms, selectTerms s)+    , (Raw.ShowExtra, selectExtra s)+    , (Raw.ShowComplement, useComplement s) ]++selectNone :: SymbolSelection+selectNone = SymbolSelection False False False False False False++class MonadSymbol m => MonadModel m where+    -- | Get the type of a Model.+    modelType :: Model s -> m s ModelType+    -- | Get the number of a Model.+    modelNumber :: Model s -> m s Natural+    -- | Get the selected symbols from a Model.+    modelSymbols :: Model s -> SymbolSelection -> m s [Symbol s]+    -- | Constant time lookup to test whether an atom is in a model.+    contains :: Model s -> Symbol s -> m s Bool+    -- | Get the cost vector of a Model+    costVector :: Model s -> m s [Integer]+    -- | Check whether optimality of a model has been proven.+    optimalityProven :: Model s -> m s Bool+    -- | Get the associated 'SolveControl' of a Model.+    context :: Model s -> m s (SolveControl s)+    -- | Add a clause from the model callback.+    modelAddClause :: Foldable t +                   => SolveControl s -> t (SymbolicLiteral s) -> m s ()++instance MonadModel IOSym where+    modelType = modelType'+    modelNumber = modelNumber'+    modelSymbols = modelSymbols'+    contains = contains'+    costVector = costVector'+    optimalityProven = optimalityProven'+    context = context'+    modelAddClause = modelAddClause'++instance MonadModel Clingo where+    modelType = modelType'+    modelNumber = modelNumber'+    modelSymbols = modelSymbols'+    contains = contains'+    costVector = costVector'+    optimalityProven = optimalityProven'+    context = context'+    modelAddClause = modelAddClause'++modelType' :: (MonadIO m, MonadThrow m) => Model s -> m ModelType+modelType' (Model m) = ModelType <$> marshall1 (Raw.modelType m)++modelNumber' :: (MonadIO m, MonadThrow m) => Model s -> m Natural+modelNumber' (Model m) = fromIntegral <$> marshall1 (Raw.modelNumber m)++modelSymbols' :: (MonadIO m) => Model s -> SymbolSelection -> m [Symbol s]+modelSymbols' (Model m) selection = liftIO $ do+    let flags = rawSymbolSelection selection+    len <- marshall1 (Raw.modelSymbolsSize m flags)+    allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.modelSymbols m flags arr len)+        as <- peekArray (fromIntegral len) arr+        mapM pureSymbol as++contains' :: (MonadIO m, MonadThrow m) => Model s -> Symbol s -> m Bool+contains' (Model m) s = toBool <$> marshall1 (Raw.modelContains m (rawSymbol s))++costVector' :: (MonadIO m) => Model s -> m [Integer]+costVector' (Model m) = liftIO $ do+    len <- marshall1 (Raw.modelCostSize m)+    allocaArray (fromIntegral len) $ \arr -> do+        marshall0 (Raw.modelCost m arr len)+        as <- peekArray (fromIntegral len) arr+        return $ fmap fromIntegral as++optimalityProven' :: (MonadIO m, MonadThrow m) => Model s -> m Bool+optimalityProven' (Model m) = toBool <$> marshall1 (Raw.modelOptimalityProven m)++context' :: (MonadIO m, MonadThrow m) => Model s -> m (SolveControl s)+context' (Model m) = SolveControl <$> marshall1 (Raw.modelContext m)++modelAddClause' :: (MonadIO m, MonadThrow m, Foldable t)+                => SolveControl s -> t (SymbolicLiteral s) -> m ()+modelAddClause' (SolveControl s) lits = marshall0 $ +    withArrayLen (map rawSymLit . toList $ lits) $ \len arr ->+        Raw.solveControlAddClause s arr (fromIntegral len)
+ src/Clingo/ProgramBuilding.hs view
@@ -0,0 +1,171 @@+-- | A module providing program building capabilities for both ground and+-- non-ground programs.+{-# LANGUAGE RankNTypes #-}+module Clingo.ProgramBuilding+(+    Backend,+    ProgramBuilder,+    Node (..),+    Literal,+    Atom,+    ExternalType (..),+    HeuristicType (..),++    assume,++    -- * Ground Programs+    GroundStatement,+    addGroundStatements,+    acycEdge,+    atom,+    atomAspifLiteral,+    negateAspifLiteral,+    external,+    heuristic,+    minimize,+    rule,+    weightedRule,+    project,++    -- * Non-Ground Programs+    --+    -- | See 'Clingo.AST' for the abstract syntax tree to build 'Statement's.+    addStatements+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch+import Data.Foldable++import Foreign+import Numeric.Natural++import qualified Clingo.Raw as Raw++import Clingo.AST (Statement)+import Clingo.Internal.AST (rawStatement, freeStatement)+import Clingo.Internal.Types+import Clingo.Internal.Utils++newtype Node = Node { unNode :: Int }+++-- | A 'GroundStatement' is a statement built from ground atoms. Because the+-- atoms are only valid within the context of clingo, they may not leave this+-- context. They can be added to the current program using the+-- 'addGroundStatements' function.+newtype GroundStatement s = +    GStmt { addGStmt :: forall m. (MonadIO m, MonadThrow m) +                     => Backend s -> m () }++-- | Build an edge directive.+acycEdge :: Foldable t+         => Node -> Node -> t (Literal s) -> GroundStatement s+acycEdge a b lits = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawLiteral . toList $ lits) $ \len arr ->+        Raw.backendAcycEdge h (fromIntegral $ unNode a) +            (fromIntegral $ unNode b) arr (fromIntegral len)++-- | Obtain a fresh atom to be used in aspif directives.+atom :: (MonadIO m, MonadThrow m)+     => Backend s -> m (Atom s)+atom (Backend h) = Atom <$> marshall1 (Raw.backendAddAtom h)++-- | Use an Atom as a positive AspifLiteral+atomAspifLiteral :: Atom s -> AspifLiteral s+atomAspifLiteral (Atom x) = AspifLiteral (fromIntegral x)++negateAspifLiteral :: AspifLiteral s -> AspifLiteral s+negateAspifLiteral (AspifLiteral x) = AspifLiteral (negate x)++-- | Add an assumption directive.+assume :: Foldable t+       => t (AspifLiteral s) -> GroundStatement s+assume lits = GStmt $ \(Backend h) -> marshall0 $ +    withArrayLen (map rawAspifLiteral . toList $ lits) $ \len arr ->+        Raw.backendAssume h arr (fromIntegral len)++-- | Build an external statement.+external :: Atom s -> ExternalType -> GroundStatement s+external a t = GStmt $ \(Backend h) -> marshall0 $+    Raw.backendExternal h (rawAtom a) (rawExtT t)++-- | Build a heuristic directive.+heuristic :: (Foldable t)+          => Atom s +          -> HeuristicType +          -> Int                    -- ^ Bias+          -> Natural                -- ^ Priority+          -> t (AspifLiteral s)     -- ^ Condition+          -> GroundStatement s+heuristic a t bias pri cs = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawAspifLiteral . toList $ cs) $ \len arr ->+        Raw.backendHeuristic h (rawAtom a) (rawHeuT t) +            (fromIntegral bias) (fromIntegral pri) arr (fromIntegral len)++-- | Build a minimize constraint (or weak constraint).+minimize :: Foldable t+         => Integer                 -- ^ Priority+         -> t (WeightedLiteral s)   -- ^ Literals to minimize+         -> GroundStatement s+minimize priority lits = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawWeightedLiteral . toList $ lits) $ \len arr ->+        Raw.backendMinimize h (fromIntegral priority) arr (fromIntegral len)++-- | Build a rule.+rule :: Foldable t+     => Bool                 -- ^ Is a choice rule?+     -> t (Atom s)           -- ^ Head+     -> t (AspifLiteral s)   -- ^ Body+     -> GroundStatement s+rule choice hd bd = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawAtom . toList $ hd) $ \hlen harr ->+        withArrayLen (map rawAspifLiteral . toList $ bd) $ \blen barr ->+            Raw.backendRule h (fromBool choice) harr (fromIntegral hlen) +                                                barr (fromIntegral blen)++-- | Build a weighted rule.+weightedRule :: Foldable t+             => Bool                    -- ^ Is a choice rule?+             -> t (Atom s)              -- ^ Head+             -> Natural                 -- ^ Lower Bound+             -> t (WeightedLiteral s)   -- ^ Body+             -> GroundStatement s+weightedRule choice hd weight bd = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawAtom . toList $ hd) $ \hlen harr ->+        withArrayLen (map rawWeightedLiteral . toList $ bd) $ \blen barr ->+            Raw.backendWeightRule h (fromBool choice) harr (fromIntegral hlen) +                                    (fromIntegral weight)+                                    barr (fromIntegral blen)++-- | Build a projection directive+project :: Foldable t+        => t (Atom s) -> GroundStatement s+project atoms = GStmt $ \(Backend h) -> marshall0 $+    withArrayLen (map rawAtom . toList $ atoms) $ \len arr ->+        Raw.backendProject h arr (fromIntegral len)++-- | Add a collection of 'GroundStatement' to the program via a 'Backend'+-- handle.+addGroundStatements :: Foldable t+                    => Backend s +                    -> t (GroundStatement s) +                    -> Clingo s ()+addGroundStatements b xs = mapM_ (`addGStmt` b) (toList xs)++-- | Add a collection of non-ground statements to the solver.+addStatements :: Traversable t+              => ProgramBuilder s +              -> t (Statement (Symbol s) (Signature s)) +              -> Clingo s ()+addStatements (ProgramBuilder b) stmts = do+    marshall0 (Raw.programBuilderBegin b)+    mapM_ go stmts `finally` marshall0 (Raw.programBuilderEnd b)++    where go stmt = do+              stmt' <- liftIO (rawStatement stmt)+              marshall0 $+                  with stmt' $ \ptr ->+                      Raw.programBuilderAdd b ptr+              liftIO (freeStatement stmt')
+ src/Clingo/Propagation.hs view
@@ -0,0 +1,248 @@+-- | High level API for writing propagators.+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms #-}+module Clingo.Propagation+(+    Propagation,+    PropagationPhase (..),+    Assignment,+    Literal,+    Signed (..),+    negateLiteral,++    -- | A propagator is defined by four functions. The first is executed during+    -- the initialization phase. The remaining three are called during solving,+    -- depending on how the propagator is initialized.+    --+    -- +    -- Initialization: This function is called once before each solving step.+    -- It is used to map relevant program literals to solver literals, add+    -- watches for solver literals, and initialize the data structures used+    -- during propagation.  This is the last point to access symbolic and theory+    -- atoms.  Once the search has started, they are no longer accessible.+    --+    -- Propagation: Can be used to add conflicts in order to propagate solver+    -- literals.+    --+    -- Undo: Is called on backjumping and can be used to synchronize internal+    -- data structures of the propagator.+    --+    -- Check: Can be used to check whether an assignment is valid.+    Propagator (..),+    emptyPropagator,+    propagatorToIO,++    addWatch,++    -- * Initialization+    countThreads,+    solverLiteral,+    propSymbolicAtoms,+    propTheoryAtoms,++    -- * Actions During Solving+    P.Clause (..),+    P.ClauseType (..),+    addClause,+    propagate,+    hasWatch,+    removeWatch,+    getThreadId,+    newLiteral,+    assignment,++    -- * Assignment+    decisionLevel,+    hasConflict,+    hasLiteral,+    levelOf,+    decision,+    isFixed,+    truthValue,++    -- * Truth Values+    TruthValue,+    pattern TruthFree,+    pattern TruthFalse,+    pattern TruthTrue,+    negateTruth+)+where++import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Catch+import Control.Monad.Reader+import Control.Monad.Trans.Maybe++import Numeric.Natural++import Clingo.Internal.Types+import Clingo.Internal.Symbol+import qualified Clingo.Internal.Propagation as P+import Clingo.Internal.Propagation (Assignment, Clause)++-- | Propagators can be in one of two phases, initialization and solving.+data PropagationPhase = Init | Solving++type family PhaseHandle (k :: PropagationPhase) s where+    PhaseHandle 'Init s = PropagateInit s+    PhaseHandle 'Solving s = PropagateCtrl s++-- | A concrete monad for propagators, which observes the invariants+-- stipulated by clingo.+newtype Propagation (phase :: PropagationPhase) s a+    = Propagation { runPropagator :: MaybeT +                                         (ReaderT (PhaseHandle phase s) IO) a }+        deriving ( Functor, Monad, Applicative+                 , MonadIO, MonadThrow )++getIOAction :: Propagation phase s () -> PhaseHandle phase s -> IO ()+getIOAction = (void .) . runReaderT . runMaybeT . runPropagator++instance MonadReader (PropagateInit s) (Propagation 'Init s) where+    ask = Propagation ask+    local f (Propagation x) = Propagation (local f x)+    reader = Propagation . reader++instance MonadReader (PropagateCtrl s) (Propagation 'Solving s) where+    ask = Propagation ask+    local f (Propagation x) = Propagation (local f x)+    reader = Propagation . reader++instance MonadSymbol (Propagation phase) where+    createSignature = createSignature'+    createNumber = createNumber'+    createSupremum = createSupremum'+    createInfimum = createInfimum'+    createString = createString'+    createFunction = createFunction'++handleStop :: P.PropagationStop -> Propagation phase s ()+handleStop P.Continue = return ()+handleStop P.Stop = Propagation empty++-- Propagator and wrapping+-- -----------------------++-- | A propagator is defined by four functions. No function is mandatory.+data Propagator s = Propagator+    { propInit      :: Maybe (Propagation 'Init s ())+    , propPropagate :: Maybe ([Literal s] -> Propagation 'Solving s ())+    , propUndo      :: Maybe ([Literal s] -> Propagation 'Solving s ())+    , propCheck     :: Maybe (Propagation 'Solving s ())+    }+    +-- | The empty propagator for convenience.+emptyPropagator :: Propagator s+emptyPropagator = Propagator Nothing Nothing Nothing Nothing++propagatorToIO :: Propagator s -> IOPropagator s+propagatorToIO prop = IOPropagator+    { propagatorInit = getIOAction <$> propInit prop+    , propagatorPropagate = runLitSolv <$> propPropagate prop+    , propagatorUndo = runLitSolv <$> propUndo prop+    , propagatorCheck = getIOAction <$> propCheck prop+    }+    where runLitSolv = flip . (getIOAction .)++-- Operations that are always available+-- ------------------------------------+class CanAddWatch (phase :: PropagationPhase) where+    mAddWatch :: Literal s -> Propagation phase s ()++instance CanAddWatch 'Init where+    mAddWatch l = ask >>= flip P.initAddWatch l++instance CanAddWatch 'Solving where+    mAddWatch l = ask >>= flip P.addWatch l++-- | Watches can be added in any phase of the propagation. The propagate and+-- undo functions will only be called on changes to watched literals!+addWatch :: CanAddWatch phase => Literal s -> Propagation phase s ()+addWatch = mAddWatch++-- Actions during initialization+-- -----------------------------++-- | Obtain the number of solver threads.+countThreads :: Propagation 'Init s Integer+countThreads = ask >>= P.countThreads++-- | Convert an 'AspifLiteral' to a solver 'Literal'.+solverLiteral :: AspifLiteral s -> Propagation 'Init s (Literal s)+solverLiteral l = ask >>= flip P.solverLiteral l++-- | Obtain a handle to the symbolic atoms, see 'Clingo.Inspection.Symbolic'+propSymbolicAtoms :: Propagation 'Init s (SymbolicAtoms s)+propSymbolicAtoms = ask >>= P.symbolicAtoms++-- | Obtain a handle to the theory atoms, see 'Clingo.Inspection.Theory'+propTheoryAtoms :: Propagation 'Init s (TheoryAtoms s)+propTheoryAtoms = ask >>= P.theoryAtoms++-- Actions during Solving+-- ----------------------++-- | Check whether a 'Literal' is watched.+hasWatch :: Literal s -> Propagation 'Solving s Bool+hasWatch l = ask >>= flip P.hasWatch l++-- | Stop watching a literal.+removeWatch :: Literal s -> Propagation 'Solving s ()+removeWatch l = ask >>= flip P.removeWatch l++-- | Get the thread id of the calling solver thread.+getThreadId :: Propagation 'Solving s Integer+getThreadId = ask >>= P.getThreadId++-- | Introduce a new literal to the solver.+newLiteral :: Propagation 'Solving s (Literal s)+newLiteral = ask >>= P.addLiteral++-- | Add a clause. This call might result in termination of the propagation+-- function, when backjumping is necessary.+addClause :: Clause s -> Propagation 'Solving s ()+addClause c = ask >>= flip P.addClause c >>= handleStop++-- | Propagate implied literals from added clauses. Might result in backjumping+-- and hence termination of the propagation.+propagate :: Propagation 'Solving s ()+propagate = ask >>= P.propagate >>= handleStop++-- | Obtain the current (partial) assignment.+assignment :: Propagation 'Solving s (Assignment s)+assignment = ask >>= P.assignment++-- | Get the current decision level.+decisionLevel :: Assignment s -> Propagation 'Solving s Natural+decisionLevel = P.decisionLevel++-- | Determine whether assignment has a conflict.+hasConflict :: Assignment s -> Propagation 'Solving s Bool+hasConflict = P.hasConflict++-- | Determine whether a literal is part of an assignment.+hasLiteral :: Assignment s -> Literal s -> Propagation 'Solving s Bool+hasLiteral = P.hasLiteral++-- | Find the decision level of a given literal in an assignment.+levelOf :: Assignment s -> Literal s -> Propagation 'Solving s Natural+levelOf = P.levelOf++-- | Determine the decision literal given a decision level.+decision :: Assignment s -> Natural -> Propagation 'Solving s (Literal s)+decision = P.decision++-- | Check if a literal has a fixed truth value.+isFixed :: Assignment s -> Literal s -> Propagation 'Solving s Bool+isFixed = P.isFixed++-- | Obtain the truth value of a literal+truthValue :: Assignment s -> Literal s -> Propagation 'Solving s TruthValue+truthValue = P.truthValue
+ src/Clingo/Raw.hs view
@@ -0,0 +1,31 @@+-- | Raw bindings to the clingo C API. The functions provided here are+-- equivalent to the functions provided by the C API. In almost all cases you+-- want to use the high level bindings instead. The raw modules are exported for+-- users who want to build their own abstraction, or need an unsafe interface+-- for optimization reasons.+--+-- For documentation, please refer to the C documentation at+-- https://potassco.org/clingo/c-api/current/+--+-- When importing both the Raw module and the high level wrappers, please+-- consider using qualified imports, because they share multiple names.+module Clingo.Raw+(+    module X+)+where++import Clingo.Raw.AST as X+import Clingo.Raw.Basic as X+import Clingo.Raw.Configuration as X+import Clingo.Raw.Control as X+import Clingo.Raw.Enums as X+import Clingo.Raw.Inspection.Symbolic as X+import Clingo.Raw.Inspection.Theory as X+import Clingo.Raw.Model as X+import Clingo.Raw.ProgramBuilding as X+import Clingo.Raw.Propagation as X+import Clingo.Raw.Solving as X+import Clingo.Raw.Statistics as X+import Clingo.Raw.Symbol as X+import Clingo.Raw.Types as X
+ src/Clingo/Raw/AST.hsc view
@@ -0,0 +1,1462 @@+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Clingo.Raw.AST+(+    -- * Enumerations+    AstComparisonOperator,++    pattern AstComparisonOperatorGreaterThan,+    pattern AstComparisonOperatorLessThan,+    pattern AstComparisonOperatorLessEqual,+    pattern AstComparisonOperatorGreaterEqual,+    pattern AstComparisonOperatorNotEqual,+    pattern AstComparisonOperatorEqual,++    AstSign,++    pattern AstSignNone,+    pattern AstSignNegation,+    pattern AstSignDoubleNegation,++    AstTermType,++    pattern AstTermTypeSymbol,+    pattern AstTermTypeVariable,+    pattern AstTermTypeUnaryOperation,+    pattern AstTermTypeBinaryOperation,+    pattern AstTermTypeInterval,+    pattern AstTermTypeFunction,+    pattern AstTermTypeExternalFunction,+    pattern AstTermTypePool,++    AstUnaryOperator,++    pattern AstUnaryOperatorMinus,+    pattern AstUnaryOperatorNegation,+    pattern AstUnaryOperatorAbsolute,++    AstBinaryOperator,++    pattern AstBinaryOperatorXor,+    pattern AstBinaryOperatorOr,+    pattern AstBinaryOperatorAnd,+    pattern AstBinaryOperatorPlus,+    pattern AstBinaryOperatorMinus,+    pattern AstBinaryOperatorMultiplication,+    pattern AstBinaryOperatorDivision,+    pattern AstBinaryOperatorModulo,++    AstLiteralType,++    pattern AstLiteralTypeBoolean,+    pattern AstLiteralTypeSymbolic,+    pattern AstLiteralTypeComparison,+    pattern AstLiteralTypeCsp,++    AstAggregateFunction,++    pattern AstAggregateFunctionCount,+    pattern AstAggregateFunctionSum,+    pattern AstAggregateFunctionSump,+    pattern AstAggregateFunctionMin,+    pattern AstAggregateFunctionMax,++    AstTheoryTermType,++    pattern AstTheoryTermTypeSymbol,+    pattern AstTheoryTermTypeVariable,+    pattern AstTheoryTermTypeTuple,+    pattern AstTheoryTermTypeList,+    pattern AstTheoryTermTypeSet,+    pattern AstTheoryTermTypeFunction,+    pattern AstTheoryTermTypeUnparsedTerm,++    AstHeadLiteralType,++    pattern AstHeadLiteralTypeLiteral,+    pattern AstHeadLiteralTypeDisjunction,+    pattern AstHeadLiteralTypeAggregate,+    pattern AstHeadLiteralTypeHeadAggregate,+    pattern AstHeadLiteralTypeTheoryAtom,++    AstBodyLiteralType,++    pattern AstBodyLiteralTypeLiteral,+    pattern AstBodyLiteralTypeConditional,+    pattern AstBodyLiteralTypeAggregate,+    pattern AstBodyLiteralTypeBodyAggregate,+    pattern AstBodyLiteralTypeTheoryAtom,+    pattern AstBodyLiteralTypeDisjoint,++    AstTheoryOperatorType,++    pattern AstTheoryOperatorTypeUnary,+    pattern AstTheoryOperatorTypeBinaryLeft,+    pattern AstTheoryOperatorTypeBinaryRight,++    AstTheoryAtomDefType,++    pattern AstTheoryAtomDefinitionTypeHead,+    pattern AstTheoryAtomDefinitionTypeBody,+    pattern AstTheoryAtomDefinitionTypeAny,+    pattern AstTheoryAtomDefinitionTypeDirective,++    AstScriptType,++    pattern AstScriptTypeLua,+    pattern AstScriptTypePython,++    AstStatementType,++    pattern AstStatementTypeRule,+    pattern AstStatementTypeConst,+    pattern AstStatementTypeShowSignature,+    pattern AstStatementTypeShowTerm,+    pattern AstStatementTypeMinimize,+    pattern AstStatementTypeScript,+    pattern AstStatementTypeProgram,+    pattern AstStatementTypeExternal,+    pattern AstStatementTypeEdge,+    pattern AstStatementTypeHeuristic,+    pattern AstStatementTypeProjectAtom,+    pattern AstStatementTypeProjectAtomSignature,+    pattern AstStatementTypeTheoryDefinition,++    -- * Syntax Tree Definitions+    AstUnaryOperation (..),+    AstBinaryOperation (..),+    AstInterval (..),+    AstFunction (..),+    AstPool (..),+    AstTerm (..),+    AstCspProductTerm (..),+    AstCspSumTerm (..),+    AstCspGuard (..),+    AstCspLiteral (..),+    AstId (..),+    AstComparison (..),+    AstLiteral (..),+    AstAggregateGuard (..),+    AstConditionalLiteral (..),+    AstAggregate (..),+    AstBodyAggregateElement (..),+    AstBodyAggregate (..),+    AstHeadAggregateElement (..),+    AstHeadAggregate (..),+    AstDisjunction (..),+    AstDisjointElement (..),+    AstDisjoint (..),+    AstTheoryTermArray (..),+    AstTheoryFunction (..),+    AstTheoryUnparsedTermElement (..),+    AstTheoryUnparsedTerm (..),+    AstTheoryTerm (..),+    AstTheoryAtomElement (..),+    AstTheoryGuard (..),+    AstTheoryAtom (..),+    AstHeadLiteral (..),+    AstBodyLiteral (..),+    AstTheoryOperatorDefinition (..),+    AstTheoryTermDefinition (..),+    AstTheoryGuardDefinition (..),+    AstTheoryAtomDefinition (..),+    AstTheoryDefinition (..),+    AstRule (..),+    AstDefinition (..),+    AstShowSignature (..),+    AstShowTerm (..),+    AstMinimize (..),+    AstScript (..),+    AstProgram (..),+    AstExternal (..),+    AstEdge (..),+    AstHeuristic (..),+    AstProject (..),+    AstStatement (..),++    -- * Functions+    CallbackAST,+    mkCallbackAst,+    parseProgram,+)+where++import Control.Monad.IO.Class++import Foreign+import Foreign.C++import Clingo.Raw.Types++#include <clingo.h>++type AstComparisonOperator = #type clingo_ast_comparison_operator_t++pattern AstComparisonOperatorGreaterThan = #{const clingo_ast_comparison_operator_greater_than}+pattern AstComparisonOperatorLessThan = #{const clingo_ast_comparison_operator_less_than}+pattern AstComparisonOperatorLessEqual = #{const clingo_ast_comparison_operator_less_equal}+pattern AstComparisonOperatorGreaterEqual = #{const clingo_ast_comparison_operator_greater_equal}+pattern AstComparisonOperatorNotEqual = #{const clingo_ast_comparison_operator_not_equal}+pattern AstComparisonOperatorEqual = #{const clingo_ast_comparison_operator_equal}++type AstSign = #type clingo_ast_sign_t++pattern AstSignNone = #{const clingo_ast_sign_none}+pattern AstSignNegation = #{const clingo_ast_sign_negation}+pattern AstSignDoubleNegation = #{const clingo_ast_sign_double_negation}++type AstTermType = #type clingo_ast_term_type_t++pattern AstTermTypeSymbol = #{const clingo_ast_term_type_symbol}+pattern AstTermTypeVariable = #{const clingo_ast_term_type_variable}+pattern AstTermTypeUnaryOperation = #{const clingo_ast_term_type_unary_operation}+pattern AstTermTypeBinaryOperation = #{const clingo_ast_term_type_binary_operation}+pattern AstTermTypeInterval = #{const clingo_ast_term_type_interval}+pattern AstTermTypeFunction = #{const clingo_ast_term_type_function}+pattern AstTermTypeExternalFunction = #{const clingo_ast_term_type_external_function}+pattern AstTermTypePool = #{const clingo_ast_term_type_pool}++type AstUnaryOperator = #type clingo_ast_unary_operator_t++pattern AstUnaryOperatorMinus = #{const clingo_ast_unary_operator_minus}+pattern AstUnaryOperatorNegation = #{const clingo_ast_unary_operator_negation}+pattern AstUnaryOperatorAbsolute = #{const clingo_ast_unary_operator_absolute}++type AstBinaryOperator = #type clingo_ast_binary_operator_t++pattern AstBinaryOperatorXor = #{const clingo_ast_binary_operator_xor}+pattern AstBinaryOperatorOr = #{const clingo_ast_binary_operator_or}+pattern AstBinaryOperatorAnd = #{const clingo_ast_binary_operator_and}+pattern AstBinaryOperatorPlus = #{const clingo_ast_binary_operator_plus}+pattern AstBinaryOperatorMinus = #{const clingo_ast_binary_operator_minus}+pattern AstBinaryOperatorMultiplication = #{const clingo_ast_binary_operator_multiplication}+pattern AstBinaryOperatorDivision = #{const clingo_ast_binary_operator_division}+pattern AstBinaryOperatorModulo = #{const clingo_ast_binary_operator_modulo}++type AstLiteralType = #type clingo_ast_literal_type_t++pattern AstLiteralTypeBoolean = #{const clingo_ast_literal_type_boolean}+pattern AstLiteralTypeSymbolic = #{const clingo_ast_literal_type_symbolic}+pattern AstLiteralTypeComparison = #{const clingo_ast_literal_type_comparison}+pattern AstLiteralTypeCsp = #{const clingo_ast_literal_type_csp}++type AstAggregateFunction = #type clingo_ast_aggregate_function_t++pattern AstAggregateFunctionCount = #{const clingo_ast_aggregate_function_count}+pattern AstAggregateFunctionSum = #{const clingo_ast_aggregate_function_sum}+pattern AstAggregateFunctionSump = #{const clingo_ast_aggregate_function_sump}+pattern AstAggregateFunctionMin = #{const clingo_ast_aggregate_function_min}+pattern AstAggregateFunctionMax = #{const clingo_ast_aggregate_function_max}++type AstTheoryTermType = #type clingo_ast_theory_term_type_t++pattern AstTheoryTermTypeSymbol = #{const clingo_ast_theory_term_type_symbol}+pattern AstTheoryTermTypeVariable = #{const clingo_ast_theory_term_type_variable}+pattern AstTheoryTermTypeTuple = #{const clingo_ast_theory_term_type_tuple}+pattern AstTheoryTermTypeList = #{const clingo_ast_theory_term_type_list}+pattern AstTheoryTermTypeSet = #{const clingo_ast_theory_term_type_set}+pattern AstTheoryTermTypeFunction = #{const clingo_ast_theory_term_type_function}+pattern AstTheoryTermTypeUnparsedTerm = #{const clingo_ast_theory_term_type_unparsed_term}++type AstHeadLiteralType = #type clingo_ast_head_literal_type_t++pattern AstHeadLiteralTypeLiteral = #{const clingo_ast_head_literal_type_literal}+pattern AstHeadLiteralTypeDisjunction = #{const clingo_ast_head_literal_type_disjunction}+pattern AstHeadLiteralTypeAggregate = #{const clingo_ast_head_literal_type_aggregate}+pattern AstHeadLiteralTypeHeadAggregate = #{const clingo_ast_head_literal_type_head_aggregate}+pattern AstHeadLiteralTypeTheoryAtom = #{const clingo_ast_head_literal_type_theory_atom}++type AstBodyLiteralType = #type clingo_ast_body_literal_type_t++pattern AstBodyLiteralTypeLiteral = #{const clingo_ast_body_literal_type_literal}+pattern AstBodyLiteralTypeConditional = #{const clingo_ast_body_literal_type_conditional}+pattern AstBodyLiteralTypeAggregate = #{const clingo_ast_body_literal_type_aggregate}+pattern AstBodyLiteralTypeBodyAggregate = #{const clingo_ast_body_literal_type_body_aggregate}+pattern AstBodyLiteralTypeTheoryAtom = #{const clingo_ast_body_literal_type_theory_atom}+pattern AstBodyLiteralTypeDisjoint = #{const clingo_ast_body_literal_type_disjoint}++type AstTheoryOperatorType = #type clingo_ast_theory_operator_type_t++pattern AstTheoryOperatorTypeUnary = #{const clingo_ast_theory_operator_type_unary}+pattern AstTheoryOperatorTypeBinaryLeft = #{const clingo_ast_theory_operator_type_binary_left}+pattern AstTheoryOperatorTypeBinaryRight = #{const clingo_ast_theory_operator_type_binary_right}++type AstTheoryAtomDefType = #type clingo_ast_theory_atom_definition_type_t++pattern AstTheoryAtomDefinitionTypeHead = #{const clingo_ast_theory_atom_definition_type_head}+pattern AstTheoryAtomDefinitionTypeBody = #{const clingo_ast_theory_atom_definition_type_body}+pattern AstTheoryAtomDefinitionTypeAny = #{const clingo_ast_theory_atom_definition_type_any}+pattern AstTheoryAtomDefinitionTypeDirective = #{const clingo_ast_theory_atom_definition_type_directive}++type AstScriptType = #type clingo_ast_script_type_t++pattern AstScriptTypeLua = #{const clingo_ast_script_type_lua}+pattern AstScriptTypePython = #{const clingo_ast_script_type_python}++type AstStatementType = #type clingo_ast_statement_type_t++pattern AstStatementTypeRule = #{const clingo_ast_statement_type_rule}+pattern AstStatementTypeConst = #{const clingo_ast_statement_type_const}+pattern AstStatementTypeShowSignature = #{const clingo_ast_statement_type_show_signature}+pattern AstStatementTypeShowTerm = #{const clingo_ast_statement_type_show_term}+pattern AstStatementTypeMinimize = #{const clingo_ast_statement_type_minimize}+pattern AstStatementTypeScript = #{const clingo_ast_statement_type_script}+pattern AstStatementTypeProgram = #{const clingo_ast_statement_type_program}+pattern AstStatementTypeExternal = #{const clingo_ast_statement_type_external}+pattern AstStatementTypeEdge = #{const clingo_ast_statement_type_edge}+pattern AstStatementTypeHeuristic = #{const clingo_ast_statement_type_heuristic}+pattern AstStatementTypeProjectAtom = #{const clingo_ast_statement_type_project_atom}+pattern AstStatementTypeProjectAtomSignature = #{const clingo_ast_statement_type_project_atom_signature}+pattern AstStatementTypeTheoryDefinition = #{const clingo_ast_statement_type_theory_definition}++type CallbackAST a = Ptr AstStatement -> Ptr a -> IO CBool ++foreign import ccall "wrapper" mkCallbackAst ::+    CallbackAST a -> IO (FunPtr (CallbackAST a))++data AstUnaryOperation = AstUnaryOperation AstUnaryOperator AstTerm+    deriving (Eq, Show)++instance Storable AstUnaryOperation where+    sizeOf _ = #{size clingo_ast_unary_operation_t}+    alignment = sizeOf+    peek p = AstUnaryOperation +        <$> (#{peek clingo_ast_unary_operation_t, unary_operator} p)+        <*> (#{peek clingo_ast_unary_operation_t, argument} p)+    poke p (AstUnaryOperation a b) = do+        (#poke clingo_ast_unary_operation_t, unary_operator) p a+        (#poke clingo_ast_unary_operation_t, argument) p b+   +data AstBinaryOperation = AstBinaryOperation AstBinaryOperator AstTerm AstTerm+    deriving (Eq, Show)++instance Storable AstBinaryOperation where+    sizeOf _ = #{size clingo_ast_binary_operation_t}+    alignment = sizeOf+    peek p = AstBinaryOperation +        <$> (#{peek clingo_ast_binary_operation_t, binary_operator} p)+        <*> (#{peek clingo_ast_binary_operation_t, left} p)+        <*> (#{peek clingo_ast_binary_operation_t, right} p)+    poke p (AstBinaryOperation a b c) = do+        (#poke clingo_ast_binary_operation_t, binary_operator) p a+        (#poke clingo_ast_binary_operation_t, left) p b+        (#poke clingo_ast_binary_operation_t, right) p c++data AstInterval = AstInterval AstTerm AstTerm+    deriving (Eq, Show)++instance Storable AstInterval where+    sizeOf _ = #{size clingo_ast_interval_t}+    alignment = sizeOf+    peek p = AstInterval +        <$> (#{peek clingo_ast_interval_t, left} p)+        <*> (#{peek clingo_ast_interval_t, right} p)+    poke p (AstInterval a b) = do+        (#poke clingo_ast_interval_t, left) p a+        (#poke clingo_ast_interval_t, right) p b++data AstFunction = AstFunction CString (Ptr AstTerm) CSize+    deriving (Eq, Show)++instance Storable AstFunction where+    sizeOf _ = #{size clingo_ast_function_t}+    alignment = sizeOf+    peek p = AstFunction +        <$> (#{peek clingo_ast_function_t, name} p)+        <*> (#{peek clingo_ast_function_t, arguments} p)+        <*> (#{peek clingo_ast_function_t, size} p)+    poke p (AstFunction a b c) = do+        (#poke clingo_ast_function_t, name) p a+        (#poke clingo_ast_function_t, arguments) p b+        (#poke clingo_ast_function_t, size) p c++data AstPool = AstPool (Ptr AstTerm) CSize+    deriving (Eq, Show)++instance Storable AstPool where+    sizeOf _ = #{size clingo_ast_pool_t}+    alignment = sizeOf+    peek p = AstPool +        <$> (#{peek clingo_ast_pool_t, arguments} p)+        <*> (#{peek clingo_ast_pool_t, size} p)+    poke p (AstPool a b) = do+        (#poke clingo_ast_pool_t, arguments) p a+        (#poke clingo_ast_pool_t, size) p b++data AstTerm = AstTermSymbol Location Symbol+             | AstTermVariable Location CString+             | AstTermUOp Location (Ptr AstUnaryOperation)+             | AstTermBOp Location (Ptr AstBinaryOperation)+             | AstTermInterval Location (Ptr AstInterval)+             | AstTermFunction Location (Ptr AstFunction)+             | AstTermExtFunction Location (Ptr AstFunction)+             | AstTermPool Location (Ptr AstPool)+    deriving (Eq, Show)++instance Storable AstTerm where+    sizeOf _ = #{size clingo_ast_term_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_term_t, location} p)+        typ :: AstTermType <- (#{peek clingo_ast_term_t, type} p)+        case typ of+            AstTermTypeSymbol -> do+                payload <- (#{peek clingo_ast_term_t, symbol} p)+                pure $! AstTermSymbol loc payload+            AstTermTypeVariable -> do+                payload <- (#{peek clingo_ast_term_t, variable} p)+                pure $! AstTermVariable loc payload+            AstTermTypeUnaryOperation -> do+                payload <- (#{peek clingo_ast_term_t, unary_operation} p)+                pure $! AstTermUOp loc payload+            AstTermTypeBinaryOperation -> do+                payload <- (#{peek clingo_ast_term_t, binary_operation} p)+                pure $! AstTermBOp loc payload+            AstTermTypeInterval -> do+                payload <- (#{peek clingo_ast_term_t, interval} p)+                pure $! AstTermInterval loc payload+            AstTermTypeFunction -> do+                payload <- (#{peek clingo_ast_term_t, function} p)+                pure $! AstTermFunction loc payload+            AstTermTypeExternalFunction -> do+                payload <- (#{peek clingo_ast_term_t, external_function} p)+                pure $! AstTermExtFunction loc payload+            AstTermTypePool -> do+                payload <- (#{peek clingo_ast_term_t, pool} p)+                pure $! AstTermPool loc payload+            _ -> error "Malformed struct clingo_ast_term_t"+    poke p d = case d of+        AstTermSymbol l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeSymbol :: AstTermType)+            (#poke clingo_ast_term_t, symbol) p x+        AstTermVariable l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeVariable :: AstTermType)+            (#poke clingo_ast_term_t, variable) p x+        AstTermUOp l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeUnaryOperation :: AstTermType)+            (#poke clingo_ast_term_t, unary_operation) p x+        AstTermBOp l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeBinaryOperation :: AstTermType)+            (#poke clingo_ast_term_t, binary_operation) p x+        AstTermInterval l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeInterval :: AstTermType)+            (#poke clingo_ast_term_t, interval) p x+        AstTermFunction l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeFunction :: AstTermType)+            (#poke clingo_ast_term_t, function) p x+        AstTermExtFunction l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypeExternalFunction :: AstTermType)+            (#poke clingo_ast_term_t, external_function) p x+        AstTermPool l x -> do+            (#poke clingo_ast_term_t, location) p l+            (#poke clingo_ast_term_t, type) p (AstTermTypePool :: AstTermType)+            (#poke clingo_ast_term_t, pool) p x++data AstCspProductTerm = AstCspProductTerm Location AstTerm (Ptr AstTerm)+    deriving (Eq, Show)++instance Storable AstCspProductTerm where+    sizeOf _ = #{size clingo_ast_csp_product_term_t}+    alignment = sizeOf+    peek p = AstCspProductTerm +        <$> (#{peek clingo_ast_csp_product_term_t, location} p)+        <*> (#{peek clingo_ast_csp_product_term_t, coefficient} p)+        <*> (#{peek clingo_ast_csp_product_term_t, variable} p)+    poke p (AstCspProductTerm a b c) = do+        (#poke clingo_ast_csp_product_term_t, location) p a+        (#poke clingo_ast_csp_product_term_t, coefficient) p b+        (#poke clingo_ast_csp_product_term_t, variable) p c++data AstCspSumTerm = AstCspSumTerm Location (Ptr AstCspProductTerm) CSize+    deriving (Eq, Show)++instance Storable AstCspSumTerm where+    sizeOf _ = #{size clingo_ast_csp_sum_term_t}+    alignment = sizeOf+    peek p = AstCspSumTerm +        <$> (#{peek clingo_ast_csp_sum_term_t, location} p)+        <*> (#{peek clingo_ast_csp_sum_term_t, terms} p)+        <*> (#{peek clingo_ast_csp_sum_term_t, size} p)+    poke p (AstCspSumTerm a b c) = do+        (#poke clingo_ast_csp_sum_term_t, location) p a+        (#poke clingo_ast_csp_sum_term_t, terms) p b+        (#poke clingo_ast_csp_sum_term_t, size) p c+    +data AstCspGuard = AstCspGuard AstComparisonOperator AstCspSumTerm+    deriving (Eq, Show)++instance Storable AstCspGuard where+    sizeOf _ = #{size clingo_ast_csp_guard_t}+    alignment = sizeOf+    peek p = AstCspGuard +        <$> (#{peek clingo_ast_csp_guard_t, comparison} p)+        <*> (#{peek clingo_ast_csp_guard_t, term} p)+    poke p (AstCspGuard a b) = do+        (#poke clingo_ast_csp_guard_t, comparison) p a+        (#poke clingo_ast_csp_guard_t, term) p b++data AstCspLiteral = AstCspLiteral AstCspSumTerm (Ptr AstCspGuard) CSize+    deriving (Eq, Show)++instance Storable AstCspLiteral where+    sizeOf _ = #{size clingo_ast_csp_literal_t}+    alignment = sizeOf+    peek p = AstCspLiteral +        <$> (#{peek clingo_ast_csp_literal_t, term} p)+        <*> (#{peek clingo_ast_csp_literal_t, guards} p)+        <*> (#{peek clingo_ast_csp_literal_t, size} p)+    poke p (AstCspLiteral a b c) = do+        (#poke clingo_ast_csp_literal_t, term) p a+        (#poke clingo_ast_csp_literal_t, guards) p b+        (#poke clingo_ast_csp_literal_t, size) p c+    +data AstId = AstId Location CString+    deriving (Eq, Show)++instance Storable AstId where+    sizeOf _ = #{size clingo_ast_id_t}+    alignment = sizeOf+    peek p = AstId +        <$> (#{peek clingo_ast_id_t, location} p)+        <*> (#{peek clingo_ast_id_t, id} p)+    poke p (AstId a b) = do+        (#poke clingo_ast_id_t, location) p a+        (#poke clingo_ast_id_t, id) p b++data AstComparison = AstComparison AstComparisonOperator AstTerm AstTerm+    deriving (Eq, Show)++instance Storable AstComparison where+    sizeOf _ = #{size clingo_ast_comparison_t}+    alignment = sizeOf+    peek p = AstComparison +        <$> (#{peek clingo_ast_comparison_t, comparison} p)+        <*> (#{peek clingo_ast_comparison_t, left} p)+        <*> (#{peek clingo_ast_comparison_t, right} p)+    poke p (AstComparison a b c) = do+        (#poke clingo_ast_comparison_t, comparison) p a+        (#poke clingo_ast_comparison_t, left) p b+        (#poke clingo_ast_comparison_t, right) p c++data AstLiteral = AstLiteralBool Location AstSign CBool+                | AstLiteralTerm Location AstSign (Ptr AstTerm)+                | AstLiteralComp Location AstSign (Ptr AstComparison)+                | AstLiteralCSPL Location AstSign (Ptr AstCspLiteral)+    deriving (Eq, Show)++instance Storable AstLiteral where+    sizeOf _ = #{size clingo_ast_literal_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_literal_t, location} p)+        sign <- (#{peek clingo_ast_literal_t, sign} p)+        typ :: AstLiteralType <- (#{peek clingo_ast_literal_t, type} p)+        case typ of+            AstLiteralTypeBoolean -> do+                payload <- (#{peek clingo_ast_literal_t, boolean} p)+                pure $! AstLiteralBool loc sign payload+            AstLiteralTypeSymbolic -> do+                payload <- (#{peek clingo_ast_literal_t, symbol} p)+                pure $! AstLiteralTerm loc sign payload+            AstLiteralTypeComparison -> do+                payload <- (#{peek clingo_ast_literal_t, comparison} p)+                pure $! AstLiteralComp loc sign payload+            AstLiteralTypeCsp -> do+                payload <- (#{peek clingo_ast_literal_t, csp_literal} p)+                pure $! AstLiteralCSPL loc sign payload+            _ -> error "Malformed struct clingo_ast_literal_t"+    poke p d = case d of+        AstLiteralBool l s x -> do+            (#poke clingo_ast_literal_t, location) p l+            (#poke clingo_ast_literal_t, sign) p s+            (#poke clingo_ast_literal_t, type) p (AstLiteralTypeBoolean :: AstLiteralType)+            (#poke clingo_ast_literal_t, boolean) p x+        AstLiteralTerm l s x -> do+            (#poke clingo_ast_literal_t, location) p l+            (#poke clingo_ast_literal_t, sign) p s+            (#poke clingo_ast_literal_t, type) p (AstLiteralTypeSymbolic :: AstLiteralType)+            (#poke clingo_ast_literal_t, symbol) p x+        AstLiteralComp l s x -> do+            (#poke clingo_ast_literal_t, location) p l+            (#poke clingo_ast_literal_t, sign) p s+            (#poke clingo_ast_literal_t, type) p (AstLiteralTypeComparison:: AstLiteralType)+            (#poke clingo_ast_literal_t, comparison) p x+        AstLiteralCSPL l s x -> do+            (#poke clingo_ast_literal_t, location) p l+            (#poke clingo_ast_literal_t, sign) p s+            (#poke clingo_ast_literal_t, type) p (AstLiteralTypeCsp :: AstLiteralType)+            (#poke clingo_ast_literal_t, csp_literal) p x++data AstAggregateGuard = AstAggregateGuard AstComparisonOperator AstTerm+    deriving (Eq, Show)++instance Storable AstAggregateGuard where+    sizeOf _ = #{size clingo_ast_aggregate_guard_t}+    alignment = sizeOf+    peek p = AstAggregateGuard +        <$> (#{peek clingo_ast_aggregate_guard_t, comparison} p)+        <*> (#{peek clingo_ast_aggregate_guard_t, term} p)+    poke p (AstAggregateGuard a b) = do+        (#poke clingo_ast_aggregate_guard_t, comparison) p a+        (#poke clingo_ast_aggregate_guard_t, term) p b++data AstConditionalLiteral = AstConditionalLiteral AstLiteral +                             (Ptr AstLiteral) CSize+    deriving (Eq, Show)++instance Storable AstConditionalLiteral where+    sizeOf _ = #{size clingo_ast_conditional_literal_t}+    alignment = sizeOf+    peek p = AstConditionalLiteral +        <$> (#{peek clingo_ast_conditional_literal_t, literal} p)+        <*> (#{peek clingo_ast_conditional_literal_t, condition} p)+        <*> (#{peek clingo_ast_conditional_literal_t, size} p)+    poke p (AstConditionalLiteral a b c) = do+        (#poke clingo_ast_conditional_literal_t, literal) p a+        (#poke clingo_ast_conditional_literal_t, condition) p b+        (#poke clingo_ast_conditional_literal_t, size) p c++data AstAggregate = AstAggregate (Ptr AstConditionalLiteral) CSize+                    (Ptr AstAggregateGuard) (Ptr AstAggregateGuard)+    deriving (Eq, Show)++instance Storable AstAggregate where+    sizeOf _ = #{size clingo_ast_aggregate_t}+    alignment = sizeOf+    peek p = AstAggregate +        <$> (#{peek clingo_ast_aggregate_t, elements} p)+        <*> (#{peek clingo_ast_aggregate_t, size} p)+        <*> (#{peek clingo_ast_aggregate_t, left_guard} p)+        <*> (#{peek clingo_ast_aggregate_t, right_guard} p)+    poke p (AstAggregate a b c d) = do+        (#poke clingo_ast_aggregate_t, elements) p a+        (#poke clingo_ast_aggregate_t, size) p b+        (#poke clingo_ast_aggregate_t, left_guard) p c+        (#poke clingo_ast_aggregate_t, right_guard) p d+    +data AstBodyAggregateElement = AstBodyAggregateElement (Ptr AstTerm) CSize +                               (Ptr AstLiteral) CSize+    deriving (Eq, Show)++instance Storable AstBodyAggregateElement where+    sizeOf _ = #{size clingo_ast_body_aggregate_element_t}+    alignment = sizeOf+    peek p = AstBodyAggregateElement +        <$> (#{peek clingo_ast_body_aggregate_element_t, tuple} p)+        <*> (#{peek clingo_ast_body_aggregate_element_t, tuple_size} p)+        <*> (#{peek clingo_ast_body_aggregate_element_t, condition} p)+        <*> (#{peek clingo_ast_body_aggregate_element_t, condition_size} p)+    poke p (AstBodyAggregateElement a b c d) = do+        (#poke clingo_ast_body_aggregate_element_t, tuple) p a+        (#poke clingo_ast_body_aggregate_element_t, tuple_size) p b+        (#poke clingo_ast_body_aggregate_element_t, condition) p c+        (#poke clingo_ast_body_aggregate_element_t, condition_size) p d+    +data AstBodyAggregate = AstBodyAggregate AstAggregateFunction+                        (Ptr AstBodyAggregateElement) CSize+                        (Ptr AstAggregateGuard) (Ptr AstAggregateGuard)+    deriving (Eq, Show)++instance Storable AstBodyAggregate where+    sizeOf _ = #{size clingo_ast_body_aggregate_t}+    alignment = sizeOf+    peek p = AstBodyAggregate +        <$> (#{peek clingo_ast_body_aggregate_t, function} p)+        <*> (#{peek clingo_ast_body_aggregate_t, elements} p)+        <*> (#{peek clingo_ast_body_aggregate_t, size} p)+        <*> (#{peek clingo_ast_body_aggregate_t, left_guard} p)+        <*> (#{peek clingo_ast_body_aggregate_t, right_guard} p)+    poke p (AstBodyAggregate a b c d e) = do+        (#poke clingo_ast_body_aggregate_t, function) p a+        (#poke clingo_ast_body_aggregate_t, elements) p b+        (#poke clingo_ast_body_aggregate_t, size) p c+        (#poke clingo_ast_body_aggregate_t, left_guard) p d+        (#poke clingo_ast_body_aggregate_t, right_guard) p e++data AstHeadAggregateElement = AstHeadAggregateElement (Ptr AstTerm) CSize+                               AstConditionalLiteral+    deriving (Eq, Show)++instance Storable AstHeadAggregateElement where+    sizeOf _ = #{size clingo_ast_head_aggregate_element_t}+    alignment = sizeOf+    peek p = AstHeadAggregateElement +        <$> (#{peek clingo_ast_head_aggregate_element_t, tuple} p)+        <*> (#{peek clingo_ast_head_aggregate_element_t, tuple_size} p)+        <*> (#{peek clingo_ast_head_aggregate_element_t, conditional_literal} p)+    poke p (AstHeadAggregateElement a b c) = do+        (#poke clingo_ast_head_aggregate_element_t, tuple) p a+        (#poke clingo_ast_head_aggregate_element_t, tuple_size) p b+        (#poke clingo_ast_head_aggregate_element_t, conditional_literal) p c+    +data AstHeadAggregate = AstHeadAggregate AstAggregateFunction+                        (Ptr AstHeadAggregateElement) CSize+                        (Ptr AstAggregateGuard) (Ptr AstAggregateGuard)+    deriving (Eq, Show)++instance Storable AstHeadAggregate where+    sizeOf _ = #{size clingo_ast_aggregate_t}+    alignment = sizeOf+    peek p = AstHeadAggregate +        <$> (#{peek clingo_ast_head_aggregate_t, function} p)+        <*> (#{peek clingo_ast_head_aggregate_t, elements} p)+        <*> (#{peek clingo_ast_head_aggregate_t, size} p)+        <*> (#{peek clingo_ast_head_aggregate_t, left_guard} p)+        <*> (#{peek clingo_ast_head_aggregate_t, right_guard} p)+    poke p (AstHeadAggregate a b c d e) = do+        (#poke clingo_ast_head_aggregate_t, function) p a+        (#poke clingo_ast_head_aggregate_t, elements) p b+        (#poke clingo_ast_head_aggregate_t, size) p c+        (#poke clingo_ast_head_aggregate_t, left_guard) p d+        (#poke clingo_ast_head_aggregate_t, right_guard) p e+    +data AstDisjunction = AstDisjunction (Ptr AstConditionalLiteral) CSize+    deriving (Eq, Show)++instance Storable AstDisjunction where+    sizeOf _ = #{size clingo_ast_disjunction_t}+    alignment = sizeOf+    peek p = AstDisjunction +        <$> (#{peek clingo_ast_disjunction_t, elements} p)+        <*> (#{peek clingo_ast_disjunction_t, size} p)+    poke p (AstDisjunction a b) = do+        (#poke clingo_ast_disjunction_t, elements) p a+        (#poke clingo_ast_disjunction_t, size) p b+    +data AstDisjointElement = AstDisjointElement Location (Ptr AstTerm) CSize+                          AstCspSumTerm (Ptr AstLiteral) CSize+    deriving (Eq, Show)++instance Storable AstDisjointElement where+    sizeOf _ = #{size clingo_ast_disjoint_element_t}+    alignment = sizeOf+    peek p = AstDisjointElement +        <$> (#{peek clingo_ast_disjoint_element_t, location} p)+        <*> (#{peek clingo_ast_disjoint_element_t, tuple} p)+        <*> (#{peek clingo_ast_disjoint_element_t, tuple_size} p)+        <*> (#{peek clingo_ast_disjoint_element_t, term} p)+        <*> (#{peek clingo_ast_disjoint_element_t, condition} p)+        <*> (#{peek clingo_ast_disjoint_element_t, condition_size} p)+    poke p (AstDisjointElement a b c d e f) = do+        (#poke clingo_ast_disjoint_element_t, location) p a+        (#poke clingo_ast_disjoint_element_t, tuple) p b+        (#poke clingo_ast_disjoint_element_t, tuple_size) p c+        (#poke clingo_ast_disjoint_element_t, term) p d+        (#poke clingo_ast_disjoint_element_t, condition) p e+        (#poke clingo_ast_disjoint_element_t, condition_size) p f+    +data AstDisjoint = AstDisjoint (Ptr AstDisjointElement) CSize+    deriving (Eq, Show)++instance Storable AstDisjoint where+    sizeOf _ = #{size clingo_ast_disjoint_t}+    alignment = sizeOf+    peek p = AstDisjoint +        <$> (#{peek clingo_ast_disjoint_t, elements} p)+        <*> (#{peek clingo_ast_disjoint_t, size} p)+    poke p (AstDisjoint a b) = do+        (#poke clingo_ast_disjoint_t, elements) p a+        (#poke clingo_ast_disjoint_t, size) p b+    +data AstTheoryTermArray = AstTheoryTermArray (Ptr AstTheoryTerm) CSize+    deriving (Eq, Show)++instance Storable AstTheoryTermArray where+    sizeOf _ = #{size clingo_ast_theory_term_array_t}+    alignment = sizeOf+    peek p = AstTheoryTermArray +        <$> (#{peek clingo_ast_theory_term_array_t, terms} p)+        <*> (#{peek clingo_ast_theory_term_array_t, size} p)+    poke p (AstTheoryTermArray a b) = do+        (#poke clingo_ast_theory_term_array_t, terms) p a+        (#poke clingo_ast_theory_term_array_t, size) p b++data AstTheoryFunction = AstTheoryFunction CString (Ptr AstTheoryTerm) CSize+    deriving (Eq, Show)++instance Storable AstTheoryFunction where+    sizeOf _ = #{size clingo_ast_theory_function_t}+    alignment = sizeOf+    peek p = AstTheoryFunction +        <$> (#{peek clingo_ast_theory_function_t, name} p)+        <*> (#{peek clingo_ast_theory_function_t, arguments} p)+        <*> (#{peek clingo_ast_theory_function_t, size} p)+    poke p (AstTheoryFunction a b c) = do+        (#poke clingo_ast_theory_function_t, name) p a+        (#poke clingo_ast_theory_function_t, arguments) p b+        (#poke clingo_ast_theory_function_t, size) p c+    +data AstTheoryUnparsedTermElement = AstTheoryUnparsedTermElement +                                    (Ptr CString) CSize AstTheoryTerm+    deriving (Eq, Show)++instance Storable AstTheoryUnparsedTermElement where+    sizeOf _ = #{size clingo_ast_theory_unparsed_term_element_t}+    alignment = sizeOf+    peek p = AstTheoryUnparsedTermElement +        <$> (#{peek clingo_ast_theory_unparsed_term_element_t, operators} p)+        <*> (#{peek clingo_ast_theory_unparsed_term_element_t, size} p)+        <*> (#{peek clingo_ast_theory_unparsed_term_element_t, term} p)+    poke p (AstTheoryUnparsedTermElement a b c) = do+        (#poke clingo_ast_theory_unparsed_term_element_t, operators) p a+        (#poke clingo_ast_theory_unparsed_term_element_t, size) p b+        (#poke clingo_ast_theory_unparsed_term_element_t, term) p c++data AstTheoryUnparsedTerm = AstTheoryUnparsedTerm +                             (Ptr AstTheoryUnparsedTermElement) CSize+    deriving (Eq, Show)++instance Storable AstTheoryUnparsedTerm where+    sizeOf _ = #{size clingo_ast_theory_unparsed_term_t}+    alignment = sizeOf+    peek p = AstTheoryUnparsedTerm +        <$> (#{peek clingo_ast_theory_unparsed_term_t, elements} p)+        <*> (#{peek clingo_ast_theory_unparsed_term_t, size} p)+    poke p (AstTheoryUnparsedTerm a b) = do+        (#poke clingo_ast_theory_unparsed_term_t, elements) p a+        (#poke clingo_ast_theory_unparsed_term_t, size) p b+    +data AstTheoryTerm = AstTheoryTermSymbol Location Symbol+                   | AstTheoryTermVariable Location CString+                   | AstTheoryTermTuple Location (Ptr AstTheoryTermArray)+                   | AstTheoryTermList Location (Ptr AstTheoryTermArray)+                   | AstTheoryTermSet Location (Ptr AstTheoryTermArray)+                   | AstTheoryTermFunction Location (Ptr AstTheoryFunction)+                   | AstTheoryTermUnparsed Location (Ptr AstTheoryUnparsedTerm)+    deriving (Eq, Show)++instance Storable AstTheoryTerm where+    sizeOf _ = #{size clingo_ast_theory_term_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_theory_term_t, location} p)+        typ :: AstTheoryTermType <- (#{peek clingo_ast_theory_term_t, type} p)+        case typ of+            AstTheoryTermTypeSymbol -> do+                payload <- (#{peek clingo_ast_theory_term_t, symbol} p)+                pure $! AstTheoryTermSymbol loc payload+            AstTheoryTermTypeVariable -> do+                payload <- (#{peek clingo_ast_theory_term_t, variable} p)+                pure $! AstTheoryTermVariable loc payload+            AstTheoryTermTypeTuple -> do+                payload <- (#{peek clingo_ast_theory_term_t, tuple} p)+                pure $! AstTheoryTermTuple loc payload+            AstTheoryTermTypeList -> do+                payload <- (#{peek clingo_ast_theory_term_t, list} p)+                pure $! AstTheoryTermList loc payload+            AstTheoryTermTypeSet -> do+                payload <- (#{peek clingo_ast_theory_term_t, set} p)+                pure $! AstTheoryTermSet loc payload+            AstTheoryTermTypeFunction -> do+                payload <- (#{peek clingo_ast_theory_term_t, function} p)+                pure $! AstTheoryTermFunction loc payload+            AstTheoryTermTypeUnparsedTerm -> do+                payload <- (#{peek clingo_ast_theory_term_t, unparsed_term} p)+                pure $! AstTheoryTermUnparsed loc payload+            _ -> error "Malformed struct clingo_ast_theory_term_t"+    poke p d = case d of+        AstTheoryTermSymbol l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeSymbol :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, symbol) p x+        AstTheoryTermVariable l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeVariable :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, variable) p x+        AstTheoryTermTuple l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeTuple :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, tuple) p x+        AstTheoryTermList l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeList :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, list) p x+        AstTheoryTermSet l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeSet :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, set) p x+        AstTheoryTermFunction l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeFunction :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, function) p x+        AstTheoryTermUnparsed l x -> do+            (#poke clingo_ast_theory_term_t, location) p l+            (#poke clingo_ast_theory_term_t, type) p (AstTheoryTermTypeUnparsedTerm :: AstTheoryTermType)+            (#poke clingo_ast_theory_term_t, unparsed_term) p x++data AstTheoryAtomElement = AstTheoryAtomElement (Ptr AstTheoryTerm) CSize+                            (Ptr AstLiteral) CSize+    deriving (Eq, Show)++instance Storable AstTheoryAtomElement where+    sizeOf _ = #{size clingo_ast_theory_atom_element_t}+    alignment = sizeOf+    peek p = AstTheoryAtomElement +        <$> (#{peek clingo_ast_theory_atom_element_t, tuple} p)+        <*> (#{peek clingo_ast_theory_atom_element_t, tuple_size} p)+        <*> (#{peek clingo_ast_theory_atom_element_t, condition} p)+        <*> (#{peek clingo_ast_theory_atom_element_t, condition_size} p)+    poke p (AstTheoryAtomElement a b c d) = do+        (#poke clingo_ast_theory_atom_element_t, tuple) p a+        (#poke clingo_ast_theory_atom_element_t, tuple_size) p b+        (#poke clingo_ast_theory_atom_element_t, condition) p c+        (#poke clingo_ast_theory_atom_element_t, condition_size) p d+    +data AstTheoryGuard = AstTheoryGuard CString AstTheoryTerm+    deriving (Eq, Show)++instance Storable AstTheoryGuard where+    sizeOf _ = #{size clingo_ast_theory_guard_t}+    alignment = sizeOf+    peek p = AstTheoryGuard +        <$> (#{peek clingo_ast_theory_guard_t, operator_name} p)+        <*> (#{peek clingo_ast_theory_guard_t, term} p)+    poke p (AstTheoryGuard a b) = do+        (#poke clingo_ast_theory_guard_t, operator_name) p a+        (#poke clingo_ast_theory_guard_t, term) p b++data AstTheoryAtom = AstTheoryAtom AstTerm (Ptr AstTheoryAtomElement) CSize+                     AstTheoryGuard+    deriving (Eq, Show)++instance Storable AstTheoryAtom where+    sizeOf _ = #{size clingo_ast_theory_atom_t}+    alignment = sizeOf+    peek p = AstTheoryAtom +        <$> (#{peek clingo_ast_theory_atom_t, term} p)+        <*> (#{peek clingo_ast_theory_atom_t, elements} p)+        <*> (#{peek clingo_ast_theory_atom_t, size} p)+        <*> (#{peek clingo_ast_theory_atom_t, guard} p)+    poke p (AstTheoryAtom a b c d) = do+        (#poke clingo_ast_theory_atom_t, term) p a+        (#poke clingo_ast_theory_atom_t, elements) p b+        (#poke clingo_ast_theory_atom_t, size) p c+        (#poke clingo_ast_theory_atom_t, guard) p d++data AstHeadLiteral = AstHeadLiteral Location (Ptr AstLiteral)+                    | AstHeadDisjunction Location (Ptr AstDisjunction)+                    | AstHeadLitAggregate Location (Ptr AstAggregate)+                    | AstHeadHeadAggregate Location (Ptr AstHeadAggregate)+                    | AstHeadTheoryAtom Location (Ptr AstTheoryAtom)+    deriving (Eq, Show)++instance Storable AstHeadLiteral where+    sizeOf _ = #{size clingo_ast_head_literal_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_head_literal_t, location} p)+        typ :: AstHeadLiteralType <- (#{peek clingo_ast_head_literal_t, type} p)+        case typ of+            AstHeadLiteralTypeLiteral -> do+                payload <- (#{peek clingo_ast_head_literal_t, literal} p)+                pure $! AstHeadLiteral loc payload+            AstHeadLiteralTypeDisjunction -> do+                payload <- (#{peek clingo_ast_head_literal_t, disjunction} p)+                pure $! AstHeadDisjunction loc payload+            AstHeadLiteralTypeAggregate -> do+                payload <- (#{peek clingo_ast_head_literal_t, aggregate} p)+                pure $! AstHeadLitAggregate loc payload+            AstHeadLiteralTypeHeadAggregate -> do+                payload <- (#{peek clingo_ast_head_literal_t, head_aggregate} p)+                pure $! AstHeadHeadAggregate loc payload+            AstHeadLiteralTypeTheoryAtom -> do+                payload <- (#{peek clingo_ast_head_literal_t, theory_atom} p)+                pure $! AstHeadTheoryAtom loc payload+            _ -> error "Malformed struct clingo_ast_head_literal_t"+    poke p d = case d of+        AstHeadLiteral l x -> do+            (#{poke clingo_ast_head_literal_t, location}) p l+            (#{poke clingo_ast_head_literal_t, type}) p (AstHeadLiteralTypeLiteral :: AstHeadLiteralType)+            (#{poke clingo_ast_head_literal_t, literal}) p x+        AstHeadDisjunction l x -> do+            (#{poke clingo_ast_head_literal_t, location}) p l+            (#{poke clingo_ast_head_literal_t, type}) p (AstHeadLiteralTypeDisjunction :: AstHeadLiteralType)+            (#{poke clingo_ast_head_literal_t, disjunction}) p x+        AstHeadLitAggregate l x -> do+            (#{poke clingo_ast_head_literal_t, location}) p l+            (#{poke clingo_ast_head_literal_t, type}) p (AstHeadLiteralTypeAggregate :: AstHeadLiteralType)+            (#{poke clingo_ast_head_literal_t, aggregate}) p x+        AstHeadHeadAggregate l x -> do+            (#{poke clingo_ast_head_literal_t, location}) p l+            (#{poke clingo_ast_head_literal_t, type}) p (AstHeadLiteralTypeHeadAggregate :: AstHeadLiteralType)+            (#{poke clingo_ast_head_literal_t, head_aggregate}) p x+        AstHeadTheoryAtom l x -> do+            (#{poke clingo_ast_head_literal_t, location}) p l+            (#{poke clingo_ast_head_literal_t, type}) p (AstHeadLiteralTypeTheoryAtom :: AstHeadLiteralType)+            (#{poke clingo_ast_head_literal_t, theory_atom}) p x++data AstBodyLiteral +    = AstBodyLiteral Location AstSign (Ptr AstLiteral)+    | AstBodyConditional Location (Ptr AstConditionalLiteral)+    | AstBodyLitAggregate Location AstSign (Ptr AstAggregate)+    | AstBodyBodyAggregate Location AstSign (Ptr AstBodyAggregate)+    | AstBodyTheoryAtom Location AstSign (Ptr AstTheoryAtom)+    | AstBodyDisjoint Location AstSign (Ptr AstDisjoint)+    deriving (Eq, Show)++instance Storable AstBodyLiteral where+    sizeOf _ = #{size clingo_ast_body_literal_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_body_literal_t, location} p)+        sign <- (#{peek clingo_ast_body_literal_t, sign} p)+        typ :: AstBodyLiteralType <- (#{peek clingo_ast_body_literal_t, type} p)+        case typ of+            AstBodyLiteralTypeLiteral -> do+                payload <- (#{peek clingo_ast_body_literal_t, literal} p)+                pure $! AstBodyLiteral loc sign payload+            AstBodyLiteralTypeConditional -> do+                payload <- (#{peek clingo_ast_body_literal_t, conditional} p)+                pure $! AstBodyConditional loc payload+            AstBodyLiteralTypeAggregate -> do+                payload <- (#{peek clingo_ast_body_literal_t, aggregate} p)+                pure $! AstBodyLitAggregate loc sign payload+            AstBodyLiteralTypeBodyAggregate -> do+                payload <- (#{peek clingo_ast_body_literal_t, body_aggregate} p)+                pure $! AstBodyBodyAggregate loc sign payload+            AstBodyLiteralTypeTheoryAtom -> do+                payload <- (#{peek clingo_ast_body_literal_t, theory_atom} p)+                pure $! AstBodyTheoryAtom loc sign payload+            AstBodyLiteralTypeDisjoint -> do+                payload <- (#{peek clingo_ast_body_literal_t, disjoint} p)+                pure $! AstBodyDisjoint loc sign payload+            _ -> error "Malformed struct clingo_ast_body_literal_t"+    poke p d = case d of+        AstBodyLiteral l s x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, sign) p s+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeLiteral :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, literal) p x+        AstBodyConditional l x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeConditional :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, conditional) p x+        AstBodyLitAggregate l s x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, sign) p s+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeAggregate :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, aggregate) p x+        AstBodyBodyAggregate l s x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, sign) p s+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeBodyAggregate :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, body_aggregate) p x+        AstBodyTheoryAtom l s x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, sign) p s+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeTheoryAtom :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, theory_atom) p x+        AstBodyDisjoint l s x -> do+            (#poke clingo_ast_body_literal_t, location) p l+            (#poke clingo_ast_body_literal_t, sign) p s+            (#poke clingo_ast_body_literal_t, type) p (AstBodyLiteralTypeDisjoint :: AstBodyLiteralType)+            (#poke clingo_ast_body_literal_t, disjoint) p x++data AstTheoryOperatorDefinition = AstTheoryOperatorDefinition Location +                                   CString CUInt AstTheoryOperatorType+    deriving (Eq, Show)++instance Storable AstTheoryOperatorDefinition where+    sizeOf _ = #{size clingo_ast_theory_operator_definition_t}+    alignment = sizeOf+    peek p = AstTheoryOperatorDefinition +        <$> (#{peek clingo_ast_theory_operator_definition_t, location} p)+        <*> (#{peek clingo_ast_theory_operator_definition_t, name} p)+        <*> (#{peek clingo_ast_theory_operator_definition_t, priority} p)+        <*> (#{peek clingo_ast_theory_operator_definition_t, type} p)+    poke p (AstTheoryOperatorDefinition a b c d) = do+        (#poke clingo_ast_theory_operator_definition_t, location) p a+        (#poke clingo_ast_theory_operator_definition_t, name) p b+        (#poke clingo_ast_theory_operator_definition_t, priority) p c+        (#poke clingo_ast_theory_operator_definition_t, type) p d+    +data AstTheoryTermDefinition = AstTheoryTermDefinition Location CString+                               (Ptr AstTheoryOperatorDefinition) CSize+    deriving (Eq, Show)++instance Storable AstTheoryTermDefinition where+    sizeOf _ = #{size clingo_ast_theory_term_definition_t}+    alignment = sizeOf+    peek p = AstTheoryTermDefinition +        <$> (#{peek clingo_ast_theory_term_definition_t, location} p)+        <*> (#{peek clingo_ast_theory_term_definition_t, name} p)+        <*> (#{peek clingo_ast_theory_term_definition_t, operators} p)+        <*> (#{peek clingo_ast_theory_term_definition_t, size} p)+    poke p (AstTheoryTermDefinition a b c d) = do+        (#poke clingo_ast_theory_term_definition_t, location) p a+        (#poke clingo_ast_theory_term_definition_t, name) p b+        (#poke clingo_ast_theory_term_definition_t, operators) p c+        (#poke clingo_ast_theory_term_definition_t, size) p d+    +data AstTheoryGuardDefinition = AstTheoryGuardDefinition CString (Ptr CString) +                                CSize+    deriving (Eq, Show)++instance Storable AstTheoryGuardDefinition where+    sizeOf _ = #{size clingo_ast_theory_guard_definition_t}+    alignment = sizeOf+    peek p = AstTheoryGuardDefinition +        <$> (#{peek clingo_ast_theory_guard_definition_t, term} p)+        <*> (#{peek clingo_ast_theory_guard_definition_t, operators} p)+        <*> (#{peek clingo_ast_theory_guard_definition_t, size} p)+    poke p (AstTheoryGuardDefinition a b c) = do+        (#poke clingo_ast_theory_guard_definition_t, term) p a+        (#poke clingo_ast_theory_guard_definition_t, operators) p b+        (#poke clingo_ast_theory_guard_definition_t, size) p c++data AstTheoryAtomDefinition = AstTheoryAtomDefinition Location +                               AstTheoryAtomDefType CString CUInt CString+                               (Ptr AstTheoryGuardDefinition)+    deriving (Eq, Show)++instance Storable AstTheoryAtomDefinition where+    sizeOf _ = #{size clingo_ast_theory_atom_definition_t}+    alignment = sizeOf+    peek p = AstTheoryAtomDefinition +        <$> (#{peek clingo_ast_theory_atom_definition_t, location} p)+        <*> (#{peek clingo_ast_theory_atom_definition_t, type} p)+        <*> (#{peek clingo_ast_theory_atom_definition_t, name} p)+        <*> (#{peek clingo_ast_theory_atom_definition_t, arity} p)+        <*> (#{peek clingo_ast_theory_atom_definition_t, elements} p)+        <*> (#{peek clingo_ast_theory_atom_definition_t, guard} p)+    poke p (AstTheoryAtomDefinition a b c d e f) = do+        (#poke clingo_ast_theory_atom_definition_t, location) p a+        (#poke clingo_ast_theory_atom_definition_t, type) p b+        (#poke clingo_ast_theory_atom_definition_t, name) p c+        (#poke clingo_ast_theory_atom_definition_t, arity) p d+        (#poke clingo_ast_theory_atom_definition_t, elements) p e+        (#poke clingo_ast_theory_atom_definition_t, guard) p f++data AstTheoryDefinition = AstTheoryDefinition CString +                           (Ptr AstTheoryTermDefinition) CSize+                           (Ptr AstTheoryAtomDefinition) CSize+    deriving (Eq, Show)++instance Storable AstTheoryDefinition where+    sizeOf _ = #{size clingo_ast_theory_definition_t}+    alignment = sizeOf+    peek p = AstTheoryDefinition +        <$> (#{peek clingo_ast_theory_definition_t, name} p)+        <*> (#{peek clingo_ast_theory_definition_t, terms} p)+        <*> (#{peek clingo_ast_theory_definition_t, terms_size} p)+        <*> (#{peek clingo_ast_theory_definition_t, atoms} p)+        <*> (#{peek clingo_ast_theory_definition_t, atoms_size} p)+    poke p (AstTheoryDefinition a b c d e) = do+        (#poke clingo_ast_theory_definition_t, name) p a+        (#poke clingo_ast_theory_definition_t, terms) p b+        (#poke clingo_ast_theory_definition_t, terms_size) p c+        (#poke clingo_ast_theory_definition_t, atoms) p d+        (#poke clingo_ast_theory_definition_t, atoms_size) p e+    +data AstRule = AstRule AstHeadLiteral (Ptr AstBodyLiteral) CSize+    deriving (Eq, Show)++instance Storable AstRule where+    sizeOf _ = #{size clingo_ast_rule_t}+    alignment = sizeOf+    peek p = AstRule +        <$> (#{peek clingo_ast_rule_t, head} p)+        <*> (#{peek clingo_ast_rule_t, body} p)+        <*> (#{peek clingo_ast_rule_t, size} p)+    poke p (AstRule a b c) = do+        (#poke clingo_ast_rule_t, head) p a+        (#poke clingo_ast_rule_t, body) p b+        (#poke clingo_ast_rule_t, size) p c+    +data AstDefinition = AstDefinition CString AstTerm CBool+    deriving (Eq, Show)++instance Storable AstDefinition where+    sizeOf _ = #{size clingo_ast_definition_t}+    alignment = sizeOf+    peek p = AstDefinition +        <$> (#{peek clingo_ast_definition_t, name} p)+        <*> (#{peek clingo_ast_definition_t, value} p)+        <*> (#{peek clingo_ast_definition_t, is_default} p)+    poke p (AstDefinition a b c) = do+        (#poke clingo_ast_definition_t, name) p a+        (#poke clingo_ast_definition_t, value) p b+        (#poke clingo_ast_definition_t, is_default) p c+    +data AstShowSignature = AstShowSignature Signature CBool+    deriving (Eq, Show)++instance Storable AstShowSignature where+    sizeOf _ = #{size clingo_ast_show_signature_t}+    alignment = sizeOf+    peek p = AstShowSignature +        <$> (#{peek clingo_ast_show_signature_t, signature} p)+        <*> (#{peek clingo_ast_show_signature_t, csp} p)+    poke p (AstShowSignature a b) = do+        (#poke clingo_ast_show_signature_t, signature) p a+        (#poke clingo_ast_show_signature_t, csp) p b++data AstShowTerm = AstShowTerm AstTerm (Ptr AstBodyLiteral) CSize CBool+    deriving (Eq, Show)++instance Storable AstShowTerm where+    sizeOf _ = #{size clingo_ast_show_term_t}+    alignment = sizeOf+    peek p = AstShowTerm +        <$> (#{peek clingo_ast_show_term_t, term} p)+        <*> (#{peek clingo_ast_show_term_t, body} p)+        <*> (#{peek clingo_ast_show_term_t, size} p)+        <*> (#{peek clingo_ast_show_term_t, csp} p)+    poke p (AstShowTerm a b c d) = do+        (#poke clingo_ast_show_term_t, term) p a+        (#poke clingo_ast_show_term_t, body) p b+        (#poke clingo_ast_show_term_t, size) p c+        (#poke clingo_ast_show_term_t, csp) p d+    +data AstMinimize = AstMinimize AstTerm AstTerm (Ptr AstTerm) CSize +                   (Ptr AstBodyLiteral) CSize+    deriving (Eq, Show)++instance Storable AstMinimize where+    sizeOf _ = #{size clingo_ast_minimize_t}+    alignment = sizeOf+    peek p = AstMinimize +        <$> (#{peek clingo_ast_minimize_t, weight} p)+        <*> (#{peek clingo_ast_minimize_t, priority} p)+        <*> (#{peek clingo_ast_minimize_t, tuple} p)+        <*> (#{peek clingo_ast_minimize_t, tuple_size} p)+        <*> (#{peek clingo_ast_minimize_t, body} p)+        <*> (#{peek clingo_ast_minimize_t, body_size} p)+    poke p (AstMinimize a b c d e f) = do+        (#poke clingo_ast_minimize_t, weight) p a+        (#poke clingo_ast_minimize_t, priority) p b+        (#poke clingo_ast_minimize_t, tuple) p c+        (#poke clingo_ast_minimize_t, tuple_size) p d+        (#poke clingo_ast_minimize_t, body) p e+        (#poke clingo_ast_minimize_t, body_size) p f++data AstScript = AstScript AstScriptType CString+    deriving (Eq, Show)++instance Storable AstScript where+    sizeOf _ = #{size clingo_ast_script_t}+    alignment = sizeOf+    peek p = AstScript +        <$> (#{peek clingo_ast_script_t, type} p)+        <*> (#{peek clingo_ast_script_t, code} p)+    poke p (AstScript a b) = do+        (#poke clingo_ast_script_t, type) p a+        (#poke clingo_ast_script_t, code) p b++data AstProgram = AstProgram CString (Ptr AstId) CSize+    deriving (Eq, Show)++instance Storable AstProgram where+    sizeOf _ = #{size clingo_ast_program_t}+    alignment = sizeOf+    peek p = AstProgram +        <$> (#{peek clingo_ast_program_t, name} p)+        <*> (#{peek clingo_ast_program_t, parameters} p)+        <*> (#{peek clingo_ast_program_t, size} p)+    poke p (AstProgram a b c) = do+        (#poke clingo_ast_program_t, name) p a+        (#poke clingo_ast_program_t, parameters) p b+        (#poke clingo_ast_program_t, size) p c+    +data AstExternal = AstExternal AstTerm (Ptr AstBodyLiteral) CSize+    deriving (Eq, Show)++instance Storable AstExternal where+    sizeOf _ = #{size clingo_ast_external_t}+    alignment = sizeOf+    peek p = AstExternal +        <$> (#{peek clingo_ast_external_t, atom} p)+        <*> (#{peek clingo_ast_external_t, body} p)+        <*> (#{peek clingo_ast_external_t, size} p)+    poke p (AstExternal a b c) = do+        (#poke clingo_ast_external_t, atom) p a+        (#poke clingo_ast_external_t, body) p b+        (#poke clingo_ast_external_t, size) p c++data AstEdge = AstEdge AstTerm AstTerm (Ptr AstBodyLiteral) CSize+    deriving (Eq, Show)++instance Storable AstEdge where+    sizeOf _ = #{size clingo_ast_edge_t}+    alignment = sizeOf+    peek p = AstEdge +        <$> (#{peek clingo_ast_edge_t, u} p)+        <*> (#{peek clingo_ast_edge_t, v} p)+        <*> (#{peek clingo_ast_edge_t, body} p)+        <*> (#{peek clingo_ast_edge_t, size} p)+    poke p (AstEdge a b c d) = do+        (#poke clingo_ast_edge_t, u) p a+        (#poke clingo_ast_edge_t, v) p b+        (#poke clingo_ast_edge_t, body) p c+        (#poke clingo_ast_edge_t, size) p d+    +data AstHeuristic = AstHeuristic AstTerm (Ptr AstBodyLiteral) CSize +                    AstTerm AstTerm AstTerm+    deriving (Eq, Show)++instance Storable AstHeuristic where+    sizeOf _ = #{size clingo_ast_heuristic_t}+    alignment = sizeOf+    peek p = AstHeuristic +        <$> (#{peek clingo_ast_heuristic_t, atom} p)+        <*> (#{peek clingo_ast_heuristic_t, body} p)+        <*> (#{peek clingo_ast_heuristic_t, size} p)+        <*> (#{peek clingo_ast_heuristic_t, bias} p)+        <*> (#{peek clingo_ast_heuristic_t, priority} p)+        <*> (#{peek clingo_ast_heuristic_t, modifier} p)+    poke p (AstHeuristic a b c d e f) = do+        (#poke clingo_ast_heuristic_t, atom) p a+        (#poke clingo_ast_heuristic_t, body) p b+        (#poke clingo_ast_heuristic_t, size) p c+        (#poke clingo_ast_heuristic_t, bias) p d+        (#poke clingo_ast_heuristic_t, priority) p e+        (#poke clingo_ast_heuristic_t, modifier) p f++data AstProject = AstProject AstTerm (Ptr AstBodyLiteral) CSize+    deriving (Eq, Show)++instance Storable AstProject where+    sizeOf _ = #{size clingo_ast_project_t}+    alignment = sizeOf+    peek p = AstProject+        <$> (#{peek clingo_ast_project_t, atom} p)+        <*> (#{peek clingo_ast_project_t, body} p)+        <*> (#{peek clingo_ast_project_t, size} p)+    poke p (AstProject a b c) = do+        (#poke clingo_ast_project_t, atom) p a+        (#poke clingo_ast_project_t, body) p b+        (#poke clingo_ast_project_t, size) p c+    +data AstStatement = AstStmtRule Location (Ptr AstRule)+                  | AstStmtDefinition Location (Ptr AstDefinition)+                  | AstStmtShowSignature Location (Ptr AstShowSignature)+                  | AstStmtShowTerm Location (Ptr AstShowTerm)+                  | AstStmtMinimize Location (Ptr AstMinimize)+                  | AstStmtScript Location (Ptr AstScript)+                  | AstStmtProgram Location (Ptr AstProgram)+                  | AstStmtExternal Location (Ptr AstExternal)+                  | AstStmtEdge Location (Ptr AstEdge)+                  | AstStmtHeuristic Location (Ptr AstHeuristic)+                  | AstStmtProject Location (Ptr AstProject)+                  | AstStmtSignature Location Signature+                  | AstStmtTheoryDefn Location (Ptr AstTheoryDefinition)+    deriving (Eq, Show)++instance Storable AstStatement where+    sizeOf _ = #{size clingo_ast_unary_operation_t}+    alignment = sizeOf+    peek p = do+        loc <- (#{peek clingo_ast_statement_t, location} p)+        typ :: AstStatementType <- (#{peek clingo_ast_statement_t, type} p)+        case typ of+            AstStatementTypeRule -> do+                payload <- (#{peek clingo_ast_statement_t, rule} p)+                pure $! AstStmtRule loc payload+            AstStatementTypeConst -> do+                payload <- (#{peek clingo_ast_statement_t, definition} p)+                pure $! AstStmtDefinition loc payload+            AstStatementTypeShowSignature -> do+                payload <- (#{peek clingo_ast_statement_t, show_signature} p)+                pure $! AstStmtShowSignature loc payload+            AstStatementTypeShowTerm -> do+                payload <- (#{peek clingo_ast_statement_t, show_term} p)+                pure $! AstStmtShowTerm loc payload+            AstStatementTypeMinimize -> do+                payload <- (#{peek clingo_ast_statement_t, minimize} p)+                pure $! AstStmtMinimize loc payload+            AstStatementTypeScript -> do+                payload <- (#{peek clingo_ast_statement_t, script} p)+                pure $! AstStmtScript loc payload+            AstStatementTypeProgram -> do+                payload <- (#{peek clingo_ast_statement_t, program} p)+                pure $! AstStmtProgram loc payload+            AstStatementTypeExternal -> do+                payload <- (#{peek clingo_ast_statement_t, external} p)+                pure $! AstStmtExternal loc payload+            AstStatementTypeEdge -> do+                payload <- (#{peek clingo_ast_statement_t, edge} p)+                pure $! AstStmtEdge loc payload+            AstStatementTypeHeuristic -> do+                payload <- (#{peek clingo_ast_statement_t, heuristic} p)+                pure $! AstStmtHeuristic loc payload+            AstStatementTypeProjectAtom -> do+                payload <- (#{peek clingo_ast_statement_t, project_atom} p)+                pure $! AstStmtProject loc payload+            AstStatementTypeProjectAtomSignature -> do+                payload <- (#{peek clingo_ast_statement_t, project_signature} p)+                pure $! AstStmtSignature loc payload+            AstStatementTypeTheoryDefinition -> do+                payload <- (#{peek clingo_ast_statement_t, theory_definition} p)+                pure $! AstStmtTheoryDefn loc payload+            _ -> error "Malformed struct clingo_ast_statement_t"+    poke p d = case d of+        AstStmtRule l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeRule :: AstStatementType)+            (#poke clingo_ast_statement_t, rule) p x+        AstStmtDefinition l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeConst :: AstStatementType)+            (#poke clingo_ast_statement_t, definition) p x+        AstStmtShowSignature l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeShowSignature :: AstStatementType)+            (#poke clingo_ast_statement_t, show_signature) p x+        AstStmtShowTerm l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeShowTerm :: AstStatementType)+            (#poke clingo_ast_statement_t, show_term) p x+        AstStmtMinimize l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeMinimize :: AstStatementType)+            (#poke clingo_ast_statement_t, minimize) p x+        AstStmtScript l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeScript :: AstStatementType)+            (#poke clingo_ast_statement_t, script) p x+        AstStmtProgram l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeProgram :: AstStatementType)+            (#poke clingo_ast_statement_t, program) p x+        AstStmtExternal l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeExternal :: AstStatementType)+            (#poke clingo_ast_statement_t, external) p x+        AstStmtEdge l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeEdge :: AstStatementType)+            (#poke clingo_ast_statement_t, edge) p x+        AstStmtHeuristic l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeHeuristic :: AstStatementType)+            (#poke clingo_ast_statement_t, heuristic) p x+        AstStmtProject l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeProjectAtom :: AstStatementType)+            (#poke clingo_ast_statement_t, project_atom) p x+        AstStmtSignature l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeProjectAtomSignature :: AstStatementType)+            (#poke clingo_ast_statement_t, project_signature) p x+        AstStmtTheoryDefn l x -> do+            (#poke clingo_ast_statement_t, location) p l+            (#poke clingo_ast_statement_t, type) p (AstStatementTypeTheoryDefinition :: AstStatementType)+            (#poke clingo_ast_statement_t, theory_definition) p x++foreign import ccall "clingo.h clingo_parse_program" parseProgramFFI ::+    CString -> FunPtr (CallbackAST a) -> Ptr a -> FunPtr (Logger b) -> Ptr b +            -> CUInt -> IO CBool++parseProgram :: MonadIO m+             => CString -> FunPtr (CallbackAST a) -> Ptr a -> FunPtr (Logger b) +             -> Ptr b -> CUInt -> m CBool+parseProgram a b c d e f = liftIO $ parseProgramFFI a b c d e f
+ src/Clingo/Raw/Basic.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Basic+(+    errorString,+    errorCode,+    errorMessage,+    setError,+    warningString,+    version+)+where++import Foreign+import Foreign.C+import Control.Monad.IO.Class+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_error_string" errorStringFFI ::+    ClingoError -> IO CString+foreign import ccall "clingo.h clingo_error_code" errorCodeFFI ::+    IO ClingoError+foreign import ccall "clingo.h clingo_error_message" errorMessageFFI ::+    IO CString+foreign import ccall "clingo.h clingo_set_error" setErrorFFI ::+    ClingoError -> CString -> IO ()+foreign import ccall "clingo.h clingo_warning_string" warningStringFFI ::+    ClingoWarning -> IO CString+foreign import ccall "clingo.h clingo_version" versionFFI ::+    Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()++errorString :: MonadIO m => ClingoError -> m CString+errorString = liftIO . errorStringFFI++errorCode :: MonadIO m => m ClingoError+errorCode = liftIO errorCodeFFI++errorMessage :: MonadIO m => m CString+errorMessage = liftIO errorMessageFFI++setError :: MonadIO m => ClingoError -> CString -> m ()+setError a b = liftIO $ setErrorFFI a b++warningString :: MonadIO m => ClingoWarning -> m CString+warningString = liftIO . warningStringFFI++version :: MonadIO m => Ptr CInt -> Ptr CInt -> Ptr CInt -> m ()+version a b c = liftIO $ versionFFI a b c
+ src/Clingo/Raw/Configuration.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Configuration+(+    configurationRoot,+    configurationType,+    configurationDescription,++    -- * Functions to access arrays+    configurationArraySize,+    configurationArrayAt,+    +    -- * Functions to access maps+    configurationMapSize,+    configurationMapSubkeyName,+    configurationMapAt,++    -- * Functions to access values+    configurationValueIsAssigned,+    configurationValueGetSize,+    configurationValueGet,+    configurationValueSet+)+where++import Control.Monad.IO.Class++import Foreign+import Foreign.C++import Clingo.Raw.Enums+import Clingo.Raw.Types++foreign import ccall "clingo.h clingo_configuration_root" configurationRootFFI ::+    Configuration -> Ptr Identifier -> IO CBool+foreign import ccall "clingo.h clingo_configuration_type" configurationTypeFFI ::+    Configuration -> Identifier -> Ptr ConfigurationType -> IO CBool+foreign import ccall "clingo.h clingo_configuration_description" configurationDescriptionFFI ::+    Configuration -> Identifier -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_configuration_array_size" configurationArraySizeFFI ::+    Configuration -> Word64 -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_configuration_array_at" configurationArrayAtFFI ::+    Configuration -> Identifier -> CSize -> Ptr Identifier -> IO CBool+foreign import ccall "clingo.h clingo_configuration_map_size" configurationMapSizeFFI ::+    Configuration -> Identifier -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_configuration_map_subkey_name" configurationMapSubkeyNameFFI ::+    Configuration -> Identifier -> CSize -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_configuration_map_at" configurationMapAtFFI ::+    Configuration -> Identifier -> CString -> Ptr Identifier -> IO CBool+foreign import ccall "clingo.h clingo_configuration_value_is_assigned" configurationValueIsAssignedFFI ::+    Configuration -> Identifier -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_configuration_value_get_size" configurationValueGetSizeFFI ::+    Configuration -> Identifier -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_configuration_value_get" configurationValueGetFFI ::+    Configuration -> Identifier -> CString -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_configuration_value_set" configurationValueSetFFI ::+    Configuration -> Identifier -> CString -> IO CBool++configurationRoot :: MonadIO m => Configuration -> Ptr Identifier -> m CBool+configurationRoot a b = liftIO $ configurationRootFFI a b++configurationType :: MonadIO m => Configuration -> Identifier -> Ptr ConfigurationType -> m CBool+configurationType a b c = liftIO $ configurationTypeFFI a b c++configurationDescription :: MonadIO m => Configuration -> Identifier -> Ptr CString -> m CBool+configurationDescription a b c = liftIO $ configurationDescriptionFFI a b c++configurationArraySize :: MonadIO m => Configuration -> Word64 -> Ptr CSize -> m CBool+configurationArraySize a b c = liftIO $ configurationArraySizeFFI a b c++configurationArrayAt :: MonadIO m => Configuration -> Identifier -> CSize -> Ptr Identifier -> m CBool+configurationArrayAt a b c d = liftIO $ configurationArrayAtFFI a b c d++configurationMapSize :: MonadIO m => Configuration -> Identifier -> Ptr CSize -> m CBool+configurationMapSize a b c = liftIO $ configurationMapSizeFFI a b c++configurationMapSubkeyName :: MonadIO m => Configuration -> Identifier -> CSize -> Ptr CString -> m CBool+configurationMapSubkeyName a b c d = liftIO $ configurationMapSubkeyNameFFI a b c d++configurationMapAt :: MonadIO m => Configuration -> Identifier -> CString -> Ptr Identifier -> m CBool+configurationMapAt a b c d = liftIO $ configurationMapAtFFI a b c d++configurationValueIsAssigned :: MonadIO m => Configuration -> Identifier -> Ptr CBool -> m CBool+configurationValueIsAssigned a b c = liftIO $ configurationValueIsAssignedFFI a b c++configurationValueGetSize :: MonadIO m => Configuration -> Identifier -> Ptr CSize -> m CBool+configurationValueGetSize a b c = liftIO $ configurationValueGetSizeFFI a b c++configurationValueGet :: MonadIO m => Configuration -> Identifier -> CString -> CSize -> m CBool+configurationValueGet a b c d = liftIO $ configurationValueGetFFI a b c d++configurationValueSet :: MonadIO m => Configuration -> Identifier -> CString -> m CBool+configurationValueSet a b c = liftIO $ configurationValueSetFFI a b c
+ src/Clingo/Raw/Control.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Control+(+    controlNew,+    controlFree,++    -- * Grounding+    controlLoad,+    controlAdd,+    controlGround,++    -- * Solving+    controlSolve,+    controlCleanup,+    controlAssignExternal,+    controlReleaseExternal,+    controlRegisterPropagator,+    controlStatistics,+    controlInterrupt,+    controlClaspFacade,++    -- * Configuration+    controlConfiguration,+    controlUseEnumAssumption,+    +    -- * Program Inspection+    controlGetConst,+    controlHasConst,+    controlSymbolicAtoms,+    controlTheoryAtoms,+    controlRegisterObserver,++    -- * Program Modification+    controlBackend,+    controlProgramBuilder,+)+where++import Control.Monad.IO.Class++import Foreign+import Foreign.C.Types+import Foreign.C.String++import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_control_new" +                     controlNewFFI ::+    Ptr CString -> CSize -> FunPtr (Logger a) -> Ptr a -> CUInt +                -> Ptr Control -> IO CBool+foreign import ccall "clingo.h clingo_control_free" +                     controlFreeFFI ::+    Control -> IO ()+foreign import ccall "clingo.h clingo_control_load" +                     controlLoadFFI ::+    Control -> CString -> IO CBool+foreign import ccall "clingo.h clingo_control_add" +                     controlAddFFI ::+    Control -> CString -> Ptr CString -> CSize -> CString -> IO CBool+foreign import ccall "clingo.h clingo_control_ground" +                     controlGroundFFI ::+    Control -> Ptr Part -> CSize -> FunPtr (CallbackGround a) -> Ptr a +                -> IO CBool+foreign import ccall "clingo.h clingo_control_solve" +                     controlSolveFFI ::+    Control -> SolveMode +            -> Ptr SymbolicLiteral -> CSize+            -> FunPtr (CallbackEvent a) -> Ptr a+            -> Ptr SolveHandle -> IO CBool+foreign import ccall "clingo.h clingo_control_cleanup" +                     controlCleanupFFI ::+    Control -> IO CBool+foreign import ccall "clingo.h clingo_control_assign_external" +                     controlAssignExternalFFI ::+    Control -> Symbol -> TruthValue -> IO CBool+foreign import ccall "clingo.h clingo_control_release_external" +                     controlReleaseExternalFFI ::+    Control -> Symbol -> IO CBool+foreign import ccall "clingo.h clingo_control_register_propagator"+                     controlRegisterPropagatorFFI ::+    Control -> Ptr (Propagator a) -> Ptr a -> CBool -> IO CBool+foreign import ccall "clingo.h clingo_control_statistics" +                     controlStatisticsFFI ::+    Control -> Ptr Statistics -> IO CBool+foreign import ccall "clingo.h clingo_control_interrupt" +                     controlInterruptFFI ::+    Control -> IO ()+foreign import ccall "clingo.h clingo_control_clasp_facade" +                     controlClaspFacadeFFI ::+    Control -> Ptr (Ptr ()) -> IO CBool+foreign import ccall "clingo.h clingo_control_configuration" +                     controlConfigurationFFI ::+    Control -> Ptr Configuration -> IO CBool+foreign import ccall "clingo.h clingo_control_use_enumeration_assumption" +                     controlUseEnumAssumptionFFI ::+    Control -> CBool -> IO CBool+foreign import ccall "clingo.h clingo_control_get_const" +                     controlGetConstFFI ::+    Control -> CString -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_control_has_const" +                     controlHasConstFFI ::+    Control -> CString -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_control_symbolic_atoms" +                     controlSymbolicAtomsFFI ::+    Control -> Ptr SymbolicAtoms -> IO CBool+foreign import ccall "clingo.h clingo_control_theory_atoms" +                     controlTheoryAtomsFFI ::+    Control -> Ptr TheoryAtoms -> IO CBool+foreign import ccall "clingo.h clingo_control_register_observer"+                     controlRegisterObserverFFI ::+    Control -> Ptr (GroundProgramObserver a) -> Ptr a -> IO CBool+foreign import ccall "clingo.h clingo_control_backend" +                     controlBackendFFI ::+    Control -> Ptr Backend -> IO CBool+foreign import ccall "clingo.h clingo_control_program_builder" +                     controlProgramBuilderFFI ::+    Control -> Ptr ProgramBuilder -> IO CBool+++controlNew :: MonadIO m => Ptr CString -> CSize -> FunPtr (Logger a) +                        -> Ptr a -> CUInt -> Ptr Control -> m CBool+controlNew a b c d e f = liftIO $ controlNewFFI a b c d e f++controlFree :: MonadIO m => Control -> m ()+controlFree a = liftIO $ controlFreeFFI a++controlLoad :: MonadIO m => Control -> CString -> m CBool+controlLoad a b = liftIO $ controlLoadFFI a b++controlAdd :: MonadIO m => Control -> CString -> Ptr CString -> CSize +                        -> CString -> m CBool+controlAdd a b c d e = liftIO $ controlAddFFI a b c d e++controlGround :: MonadIO m => Control -> Ptr Part -> CSize +                           -> FunPtr (CallbackGround a) -> Ptr a -> m CBool+controlGround a b c d e = liftIO $ controlGroundFFI a b c d e++controlSolve :: MonadIO m +             => Control -> SolveMode +             -> Ptr SymbolicLiteral -> CSize+             -> FunPtr (CallbackEvent a) -> Ptr a+             -> Ptr SolveHandle -> m CBool+controlSolve a b c d e f g = liftIO $ controlSolveFFI a b c d e f g++controlCleanup :: MonadIO m => Control -> m CBool+controlCleanup a = liftIO $ controlCleanupFFI a++controlAssignExternal :: MonadIO m => Control -> Symbol -> TruthValue +                                   -> m CBool+controlAssignExternal a b c = liftIO $ controlAssignExternalFFI a b c++controlReleaseExternal :: MonadIO m => Control -> Symbol -> m CBool+controlReleaseExternal a b = liftIO $ controlReleaseExternalFFI a b++controlRegisterPropagator :: MonadIO m => Control -> Ptr (Propagator a) +                                       -> Ptr a -> CBool -> m CBool+controlRegisterPropagator a b c d = +    liftIO $ controlRegisterPropagatorFFI a b c d++controlStatistics :: MonadIO m => Control -> Ptr Statistics -> m CBool+controlStatistics a b = liftIO $ controlStatisticsFFI a b++controlInterrupt :: MonadIO m => Control -> m ()+controlInterrupt a = liftIO $ controlInterruptFFI a++controlClaspFacade :: MonadIO m => Control -> Ptr (Ptr ()) -> m CBool+controlClaspFacade a b = liftIO $ controlClaspFacadeFFI a b++controlConfiguration :: MonadIO m => Control -> Ptr Configuration+                                  -> m CBool+controlConfiguration a b = liftIO $ controlConfigurationFFI a b++controlUseEnumAssumption :: MonadIO m => Control -> CBool -> m CBool+controlUseEnumAssumption a b = liftIO $ controlUseEnumAssumptionFFI a b++controlGetConst :: MonadIO m => Control -> CString -> Ptr Symbol -> m CBool+controlGetConst a b c = liftIO $ controlGetConstFFI a b c++controlHasConst :: MonadIO m => Control -> CString -> Ptr CBool -> m CBool+controlHasConst a b c = liftIO $ controlHasConstFFI a b c++controlSymbolicAtoms :: MonadIO m => Control -> Ptr SymbolicAtoms+                                  -> m CBool+controlSymbolicAtoms a b = liftIO $ controlSymbolicAtomsFFI a b++controlTheoryAtoms :: MonadIO m => Control -> Ptr TheoryAtoms+                                -> m CBool+controlTheoryAtoms a b = liftIO $ controlTheoryAtomsFFI a b++controlRegisterObserver :: MonadIO m => Control +                                     -> Ptr (GroundProgramObserver a) -> Ptr a +                                     -> m CBool+controlRegisterObserver a b c = liftIO $ controlRegisterObserverFFI a b c++controlBackend :: MonadIO m => Control -> Ptr Backend -> m CBool+controlBackend a b = liftIO $ controlBackendFFI a b++controlProgramBuilder :: MonadIO m => Control -> Ptr ProgramBuilder+                                   -> m CBool+controlProgramBuilder a b = liftIO $ controlProgramBuilderFFI a b
+ src/Clingo/Raw/Enums.hsc view
@@ -0,0 +1,217 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Raw.Enums+(+    ClingoError,+    pattern ErrorSuccess,+    pattern ErrorRuntime,+    pattern ErrorLogic,+    pattern ErrorBadAlloc,+    pattern ErrorUnknown,++    ClingoWarning,+    pattern WarnOpUndefined,+    pattern WarnRTError,+    pattern WarnAtomUndefined,+    pattern WarnFileIncluded,+    pattern WarnVariableUnbounded,+    pattern WarnGlobalVariable,+    pattern WarnOther,++    TruthValue,+    pattern TruthFree,+    pattern TruthFalse,+    pattern TruthTrue,++    SymbolType,+    pattern SymInfimum,+    pattern SymNumber,+    pattern SymString,+    pattern SymFunction,+    pattern SymSupremum,++    ModelType,+    pattern StableModel,+    pattern BraveConsequences,+    pattern CautiousConsequences,++    ShowFlag,+    pattern ShowCSP,+    pattern ShowShown,+    pattern ShowAtoms,+    pattern ShowTerms,+    pattern ShowExtra,+    pattern ShowAll,+    pattern ShowComplement,++    SolveResult,+    pattern ResultSatisfiable,+    pattern ResultUnsatisfiable,+    pattern ResultExhausted,+    pattern ResultInterrupted,++    SolveMode,+    pattern SolveModeAsync,+    pattern SolveModeYield,++    SolveEvent,+    pattern SolveEventModel,+    pattern SolveEventFinish,++    TheoryTermType,+    pattern TheoryTuple,+    pattern TheoryList,+    pattern TheorySet,+    pattern TheoryFunction,+    pattern TheoryNumber,+    pattern TheorySymbol,++    ClauseType,+    pattern ClauseLearnt,+    pattern ClauseStatic,+    pattern ClauseVolatile,+    pattern ClauseVolatileStatic,++    HeuristicType,+    pattern HeuristicLevel,+    pattern HeuristicSign,+    pattern HeuristicFactor,+    pattern HeuristicInit,+    pattern HeuristicTrue,+    pattern HeuristicFalse,++    ExternalType,+    pattern ExternalFree,+    pattern ExternalTrue,+    pattern ExternalFalse,+    pattern ExternalRelease,++    ConfigurationType,+    pattern ConfigValue,+    pattern ConfigArray,+    pattern ConfigMap,++    StatisticsType,+    pattern StatsEmpty,+    pattern StatsValue,+    pattern StatsArray,+    pattern StatsMap+)+where++import Data.Int+import Data.Word++#include <clingo.h>++type ClingoError = (#type clingo_error_t)++pattern ErrorSuccess = #{const clingo_error_success}+pattern ErrorRuntime = #{const clingo_error_runtime}+pattern ErrorLogic = #{const clingo_error_logic}+pattern ErrorBadAlloc = #{const clingo_error_bad_alloc}+pattern ErrorUnknown = #{const clingo_error_unknown}++type ClingoWarning = (#type clingo_warning_t)++pattern WarnOpUndefined = #{const clingo_warning_operation_undefined}+pattern WarnRTError = #{const clingo_warning_runtime_error}+pattern WarnAtomUndefined = #{const clingo_warning_atom_undefined}+pattern WarnFileIncluded = #{const clingo_warning_file_included}+pattern WarnVariableUnbounded = #{const clingo_warning_variable_unbounded}+pattern WarnGlobalVariable = #{const clingo_warning_global_variable}+pattern WarnOther = #{const clingo_warning_other}++type TruthValue = (#type clingo_truth_value_t)++pattern TruthFree = #{const clingo_truth_value_free}+pattern TruthFalse = #{const clingo_truth_value_false}+pattern TruthTrue = #{const clingo_truth_value_true}++type SymbolType = (#type clingo_symbol_type_t)++pattern SymInfimum = #{const clingo_symbol_type_infimum}+pattern SymNumber = #{const clingo_symbol_type_number}+pattern SymString = #{const clingo_symbol_type_string}+pattern SymFunction = #{const clingo_symbol_type_function}+pattern SymSupremum = #{const clingo_symbol_type_supremum}++type ModelType = (#type clingo_model_type_t)++pattern StableModel = #{const clingo_model_type_stable_model}+pattern BraveConsequences = #{const clingo_model_type_brave_consequences}+pattern CautiousConsequences = #{const clingo_model_type_cautious_consequences}++type ShowFlag = (#type clingo_show_type_bitset_t)++pattern ShowCSP = #{const clingo_show_type_csp}+pattern ShowShown = #{const clingo_show_type_shown}+pattern ShowAtoms = #{const clingo_show_type_atoms}+pattern ShowTerms = #{const clingo_show_type_terms}+pattern ShowExtra = #{const clingo_show_type_extra}+pattern ShowAll = #{const clingo_show_type_all}+pattern ShowComplement = #{const clingo_show_type_complement}++type SolveResult = (#type clingo_solve_result_bitset_t)++pattern ResultSatisfiable = #{const clingo_solve_result_satisfiable}+pattern ResultUnsatisfiable = #{const clingo_solve_result_unsatisfiable}+pattern ResultExhausted = #{const clingo_solve_result_exhausted}+pattern ResultInterrupted = #{const clingo_solve_result_interrupted}++type SolveMode = (#type clingo_solve_mode_bitset_t)++pattern SolveModeAsync = #{const clingo_solve_mode_async}+pattern SolveModeYield = #{const clingo_solve_mode_yield}++type SolveEvent = (#type clingo_solve_event_type_t)+pattern SolveEventModel = #{const clingo_solve_event_type_model}+pattern SolveEventFinish = #{const clingo_solve_event_type_finish}++type TheoryTermType = (#type clingo_theory_term_type_t)++pattern TheoryTuple = #{const clingo_theory_term_type_tuple}+pattern TheoryList = #{const clingo_theory_term_type_list}+pattern TheorySet = #{const clingo_theory_term_type_set}+pattern TheoryFunction = #{const clingo_theory_term_type_function}+pattern TheoryNumber = #{const clingo_theory_term_type_number}+pattern TheorySymbol = #{const clingo_theory_term_type_symbol}++type ClauseType = (#type clingo_clause_type_t)++pattern ClauseLearnt = #{const clingo_clause_type_learnt}+pattern ClauseStatic = #{const clingo_clause_type_static}+pattern ClauseVolatile = #{const clingo_clause_type_volatile}+pattern ClauseVolatileStatic = #{const clingo_clause_type_volatile_static}++type HeuristicType = (#type clingo_heuristic_type_t)++pattern HeuristicLevel = #{const clingo_heuristic_type_level}+pattern HeuristicSign = #{const clingo_heuristic_type_sign}+pattern HeuristicFactor = #{const clingo_heuristic_type_factor}+pattern HeuristicInit = #{const clingo_heuristic_type_init}+pattern HeuristicTrue = #{const clingo_heuristic_type_true}+pattern HeuristicFalse = #{const clingo_heuristic_type_false}++type ExternalType = (#type clingo_external_type_t)++pattern ExternalFree = #{const clingo_external_type_free}+pattern ExternalTrue = #{const clingo_external_type_true}+pattern ExternalFalse = #{const clingo_external_type_false}+pattern ExternalRelease = #{const clingo_external_type_release}++type ConfigurationType = (#type clingo_configuration_type_bitset_t)++pattern ConfigValue = #{const clingo_configuration_type_value}+pattern ConfigArray = #{const clingo_configuration_type_array}+pattern ConfigMap = #{const clingo_configuration_type_map}++type StatisticsType = (#type clingo_statistics_type_t)++pattern StatsEmpty = #{const clingo_statistics_type_empty}+pattern StatsValue = #{const clingo_statistics_type_value}+pattern StatsArray = #{const clingo_statistics_type_array}+pattern StatsMap = #{const clingo_statistics_type_map}
+ src/Clingo/Raw/Inspection/Symbolic.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Inspection.Symbolic+(+    symbolicAtomsSize,+    symbolicAtomsBegin,+    symbolicAtomsEnd,+    symbolicAtomsFind,+    symbolicAtomsIteratorIsEqualTo,+    symbolicAtomsSymbol,+    symbolicAtomsIsFact,+    symbolicAtomsIsExternal,+    symbolicAtomsLiteral,+    symbolicAtomsSignaturesSize,+    symbolicAtomsSignatures,+    symbolicAtomsNext,+    symbolicAtomsIsValid+)+where++import Control.Monad.IO.Class+import Foreign+import Foreign.C+import Clingo.Raw.Types++foreign import ccall "clingo.h clingo_symbolic_atoms_size" symbolicAtomsSizeFFI ::+    SymbolicAtoms -> Ptr CSize -> IO CBool +foreign import ccall "clingo.h clingo_symbolic_atoms_begin" symbolicAtomsBeginFFI ::+    SymbolicAtoms -> Ptr Signature -> Ptr SymbolicAtomIterator -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_end" symbolicAtomsEndFFI ::+    SymbolicAtoms -> Ptr SymbolicAtomIterator -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_find" symbolicAtomsFindFFI ::+    SymbolicAtoms -> Symbol -> Ptr SymbolicAtomIterator -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_iterator_is_equal_to" symbolicAtomsIteratorIsEqualToFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> SymbolicAtomIterator -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_symbol" symbolicAtomsSymbolFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_is_fact" symbolicAtomsIsFactFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_is_external" symbolicAtomsIsExternalFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_literal" symbolicAtomsLiteralFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_signatures_size" symbolicAtomsSignaturesSizeFFI ::+    SymbolicAtoms -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_signatures" symbolicAtomsSignaturesFFI ::+    SymbolicAtoms -> Ptr Signature -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_next" symbolicAtomsNextFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr SymbolicAtomIterator -> IO CBool+foreign import ccall "clingo.h clingo_symbolic_atoms_is_valid" symbolicAtomsIsValidFFI ::+    SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> IO CBool++symbolicAtomsSize :: MonadIO m => SymbolicAtoms -> Ptr CSize -> m CBool +symbolicAtomsSize a b = liftIO $ symbolicAtomsSizeFFI a b++symbolicAtomsBegin :: MonadIO m => SymbolicAtoms -> Ptr Signature -> Ptr SymbolicAtomIterator -> m CBool+symbolicAtomsBegin a b c = liftIO $ symbolicAtomsBeginFFI a b c++symbolicAtomsEnd :: MonadIO m => SymbolicAtoms -> Ptr SymbolicAtomIterator -> m CBool+symbolicAtomsEnd a b = liftIO $ symbolicAtomsEndFFI a b++symbolicAtomsFind :: MonadIO m => SymbolicAtoms -> Symbol -> Ptr SymbolicAtomIterator -> m CBool+symbolicAtomsFind a b c = liftIO $ symbolicAtomsFindFFI a b c++symbolicAtomsIteratorIsEqualTo :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> SymbolicAtomIterator -> Ptr CBool -> m CBool+symbolicAtomsIteratorIsEqualTo a b c d = liftIO $ symbolicAtomsIteratorIsEqualToFFI a b c d++symbolicAtomsSymbol :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr Symbol -> m CBool+symbolicAtomsSymbol a b c = liftIO $ symbolicAtomsSymbolFFI a b c++symbolicAtomsIsFact :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> m CBool+symbolicAtomsIsFact a b c = liftIO $ symbolicAtomsIsFactFFI a b c++symbolicAtomsIsExternal :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> m CBool+symbolicAtomsIsExternal a b c = liftIO $ symbolicAtomsIsExternalFFI a b c++symbolicAtomsLiteral :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr Literal -> m CBool+symbolicAtomsLiteral a b c = liftIO $ symbolicAtomsLiteralFFI a b c++symbolicAtomsSignaturesSize :: MonadIO m => SymbolicAtoms -> Ptr CSize -> m CBool+symbolicAtomsSignaturesSize a b = liftIO $ symbolicAtomsSignaturesSizeFFI a b++symbolicAtomsSignatures :: MonadIO m => SymbolicAtoms -> Ptr Signature -> CSize -> m CBool+symbolicAtomsSignatures a b c = liftIO $ symbolicAtomsSignaturesFFI a b c++symbolicAtomsNext :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr SymbolicAtomIterator -> m CBool+symbolicAtomsNext a b c = liftIO $ symbolicAtomsNextFFI a b c++symbolicAtomsIsValid :: MonadIO m => SymbolicAtoms -> SymbolicAtomIterator -> Ptr CBool -> m CBool+symbolicAtomsIsValid a b c = liftIO $ symbolicAtomsIsValidFFI a b c
+ src/Clingo/Raw/Inspection/Theory.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Inspection.Theory+(+    -- * Term Inspection+    theoryAtomsTermType,+    theoryAtomsTermNumber,+    theoryAtomsTermName,+    theoryAtomsTermArguments,+    theoryAtomsTermToStringSize,+    theoryAtomsTermToString,++    -- * Element Inspection+    theoryAtomsElementTuple,+    theoryAtomsElementCondition,+    theoryAtomsElementConditionId,+    theoryAtomsElementToStringSize,+    theoryAtomsElementToString,++    -- * Atom Inspection+    theoryAtomsSize,+    theoryAtomsAtomTerm,+    theoryAtomsAtomElements,+    theoryAtomsAtomHasGuard,+    theoryAtomsAtomGuard,+    theoryAtomsAtomLiteral,+    theoryAtomsAtomToStringSize,+    theoryAtomsAtomToString+)+where++import Control.Monad.IO.Class+import Foreign+import Foreign.C+import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_theory_atoms_term_type" theoryAtomsTermTypeFFI ::+    TheoryAtoms -> Identifier -> Ptr TheoryTermType -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_term_number" theoryAtomsTermNumberFFI ::+    TheoryAtoms -> Identifier -> Ptr CInt -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_term_name" theoryAtomsTermNameFFI ::+    TheoryAtoms -> Identifier -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_term_arguments" theoryAtomsTermArgumentsFFI ::+    TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_term_to_string_size" theoryAtomsTermToStringSizeFFI ::+    TheoryAtoms -> Identifier -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_term_to_string" theoryAtomsTermToStringFFI ::+    TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_element_tuple" theoryAtomsElementTupleFFI ::+    TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_element_condition" theoryAtomsElementConditionFFI ::+    TheoryAtoms -> Identifier -> Ptr (Ptr Literal) -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_element_condition_id" theoryAtomsElementConditionIdFFI ::+    TheoryAtoms -> Identifier -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_element_to_string_size" theoryAtomsElementToStringSizeFFI ::+    TheoryAtoms -> Identifier -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_element_to_string" theoryAtomsElementToStringFFI ::+    TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_size" theoryAtomsSizeFFI ::+    TheoryAtoms -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_term" theoryAtomsAtomTermFFI ::+    TheoryAtoms -> Identifier -> Ptr Identifier -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_elements" theoryAtomsAtomElementsFFI ::+    TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_has_guard" theoryAtomsAtomHasGuardFFI ::+    TheoryAtoms -> Identifier -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_guard" theoryAtomsAtomGuardFFI ::+    TheoryAtoms -> Identifier -> Ptr CString -> Ptr Identifier -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_literal" theoryAtomsAtomLiteralFFI ::+    TheoryAtoms -> Identifier -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_to_string_size" theoryAtomsAtomToStringSizeFFI ::+    TheoryAtoms -> Identifier -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_theory_atoms_atom_to_string" theoryAtomsAtomToStringFFI ::+    TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> IO CBool++theoryAtomsTermType :: MonadIO m => TheoryAtoms -> Identifier -> Ptr TheoryTermType -> m CBool+theoryAtomsTermType a b c = liftIO $ theoryAtomsTermTypeFFI a b c++theoryAtomsTermNumber :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CInt -> m CBool+theoryAtomsTermNumber a b c = liftIO $ theoryAtomsTermNumberFFI a b c++theoryAtomsTermName :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CString -> m CBool+theoryAtomsTermName a b c = liftIO $ theoryAtomsTermNameFFI a b c++theoryAtomsTermArguments :: MonadIO m => TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> m CBool+theoryAtomsTermArguments a b c d = liftIO $ theoryAtomsTermArgumentsFFI a b c d++theoryAtomsTermToStringSize :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CSize -> m CBool+theoryAtomsTermToStringSize a b c = liftIO $ theoryAtomsTermToStringSizeFFI a b c++theoryAtomsTermToString :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> m CBool+theoryAtomsTermToString a b c d = liftIO $ theoryAtomsTermToStringFFI a b c d++theoryAtomsElementTuple :: MonadIO m => TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> m CBool+theoryAtomsElementTuple a b c d = liftIO $ theoryAtomsElementTupleFFI a b c d++theoryAtomsElementCondition :: MonadIO m => TheoryAtoms -> Identifier -> Ptr (Ptr Literal) -> Ptr CSize -> m CBool+theoryAtomsElementCondition a b c d = liftIO $ theoryAtomsElementConditionFFI a b c d++theoryAtomsElementConditionId :: MonadIO m => TheoryAtoms -> Identifier -> Ptr Literal -> m CBool+theoryAtomsElementConditionId a b c = liftIO $ theoryAtomsElementConditionIdFFI a b c++theoryAtomsElementToStringSize :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CSize -> m CBool+theoryAtomsElementToStringSize a b c = liftIO $ theoryAtomsElementToStringSizeFFI a b c++theoryAtomsElementToString :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> m CBool+theoryAtomsElementToString a b c d = liftIO $ theoryAtomsElementToStringFFI a b c d++theoryAtomsSize :: MonadIO m => TheoryAtoms -> Ptr CSize -> m CBool+theoryAtomsSize a b = liftIO $ theoryAtomsSizeFFI a b++theoryAtomsAtomTerm :: MonadIO m => TheoryAtoms -> Identifier -> Ptr Identifier -> m CBool+theoryAtomsAtomTerm a b c = liftIO $ theoryAtomsAtomTermFFI a b c++theoryAtomsAtomElements :: MonadIO m => TheoryAtoms -> Identifier -> Ptr (Ptr Identifier) -> Ptr CSize -> m CBool+theoryAtomsAtomElements a b c d = liftIO $ theoryAtomsAtomElementsFFI a b c d++theoryAtomsAtomHasGuard :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CBool -> m CBool+theoryAtomsAtomHasGuard a b c = liftIO $ theoryAtomsAtomHasGuardFFI a b c++theoryAtomsAtomGuard :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CString -> Ptr Identifier -> m CBool+theoryAtomsAtomGuard a b c d = liftIO $ theoryAtomsAtomGuardFFI a b c d++theoryAtomsAtomLiteral :: MonadIO m => TheoryAtoms -> Identifier -> Ptr Literal -> m CBool+theoryAtomsAtomLiteral a b c = liftIO $ theoryAtomsAtomLiteralFFI a b c++theoryAtomsAtomToStringSize :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CSize -> m CBool+theoryAtomsAtomToStringSize a b c = liftIO $ theoryAtomsAtomToStringSizeFFI a b c ++theoryAtomsAtomToString :: MonadIO m => TheoryAtoms -> Identifier -> Ptr CChar -> CSize -> m CBool+theoryAtomsAtomToString a b c d = liftIO $ theoryAtomsAtomToStringFFI a b c d
+ src/Clingo/Raw/Model.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Model+(+    -- * Inspecting Models+    modelType,+    modelNumber,+    modelSymbolsSize,+    modelSymbols,+    modelContains,+    modelCostSize,+    modelCost,+    modelOptimalityProven,++    -- * Adding Clauses+    modelContext,+    solveControlAddClause+)+where++import Control.Monad.IO.Class+import Foreign+import Foreign.C+import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_model_type" modelTypeFFI ::+    Model -> Ptr ModelType -> IO CBool+foreign import ccall "clingo.h clingo_model_number" modelNumberFFI ::+    Model -> Ptr Word64 -> IO CBool+foreign import ccall "clingo.h clingo_model_symbols_size" modelSymbolsSizeFFI ::+    Model -> ShowFlag -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_model_symbols" modelSymbolsFFI ::+    Model -> ShowFlag -> Ptr Symbol -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_model_contains" modelContainsFFI ::+    Model -> Symbol -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_model_cost_size" modelCostSizeFFI ::+    Model -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_model_cost" modelCostFFI ::+    Model -> Ptr Int64 -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_model_optimality_proven" +    modelOptimalityProvenFFI ::+    Model -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_model_context" modelContextFFI ::+    Model -> Ptr SolveControl -> IO CBool+foreign import ccall "clingo.h clingo_solve_control_add_clause" +    solveControlAddClauseFFI ::+    SolveControl -> Ptr SymbolicLiteral -> CSize -> IO CBool++modelType :: MonadIO m => Model -> Ptr ModelType -> m CBool+modelType a b = liftIO $ modelTypeFFI a b++modelNumber :: MonadIO m => Model -> Ptr Word64 -> m CBool+modelNumber a b = liftIO $ modelNumberFFI a b++modelSymbolsSize :: MonadIO m => Model -> ShowFlag -> Ptr CSize -> m CBool+modelSymbolsSize a b c = liftIO $ modelSymbolsSizeFFI a b c++modelSymbols :: MonadIO m => Model -> ShowFlag -> Ptr Symbol -> CSize +                          -> m CBool+modelSymbols a b c d = liftIO $ modelSymbolsFFI a b c d++modelContains :: MonadIO m => Model -> Symbol -> Ptr CBool -> m CBool+modelContains a b c = liftIO $ modelContainsFFI a b c++modelCostSize :: MonadIO m => Model -> Ptr CSize -> m CBool+modelCostSize a b = liftIO $ modelCostSizeFFI a b++modelCost :: MonadIO m => Model -> Ptr Int64 -> CSize -> m CBool+modelCost a b c = liftIO $ modelCostFFI a b c++modelOptimalityProven :: MonadIO m => Model -> Ptr CBool -> m CBool+modelOptimalityProven a b = liftIO $ modelOptimalityProvenFFI a b++modelContext :: MonadIO m => Model -> Ptr SolveControl -> m CBool+modelContext a b = liftIO $ modelContextFFI a b++solveControlAddClause :: MonadIO m => SolveControl -> Ptr SymbolicLiteral +                                   -> CSize -> m CBool+solveControlAddClause a b c = liftIO $ solveControlAddClauseFFI a b c
+ src/Clingo/Raw/ProgramBuilding.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.ProgramBuilding+(+    backendRule,+    backendWeightRule,+    backendMinimize,+    backendProject,+    backendExternal,+    backendAssume,+    backendHeuristic,+    backendAcycEdge,+    backendAddAtom,+    programBuilderBegin,+    programBuilderAdd,+    programBuilderEnd+)+where++import Control.Monad.IO.Class++import Foreign+import Foreign.C++import Clingo.Raw.AST+import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_backend_rule" backendRuleFFI ::+    Backend -> CBool -> Ptr Atom -> CSize -> Ptr Literal -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_weight_rule" backendWeightRuleFFI ::+    Backend -> CBool -> Ptr Atom -> CSize -> Weight -> Ptr WeightedLiteral -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_minimize" backendMinimizeFFI ::+    Backend -> Weight -> Ptr WeightedLiteral -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_project" backendProjectFFI ::+    Backend -> Ptr Atom -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_external" backendExternalFFI ::+    Backend -> Atom -> ExternalType -> IO CBool+foreign import ccall "clingo.h clingo_backend_assume" backendAssumeFFI ::+    Backend -> Ptr Literal -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_heuristic" backendHeuristicFFI ::+    Backend -> Atom -> HeuristicType -> CInt -> CUInt -> Ptr Literal -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_acyc_edge" backendAcycEdgeFFI ::+    Backend -> CInt -> CInt -> Ptr Literal -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_backend_add_atom" backendAddAtomFFI ::+    Backend -> Ptr Atom -> IO CBool+foreign import ccall "clingo.h clingo_program_builder_begin" programBuilderBeginFFI ::+    ProgramBuilder -> IO CBool+foreign import ccall "clingo.h clingo_program_builder_add" programBuilderAddFFI ::+    ProgramBuilder -> Ptr AstStatement -> IO CBool+foreign import ccall "clingo.h clingo_program_builder_end" programBuilderEndFFI ::+    ProgramBuilder -> IO CBool++backendRule :: MonadIO m => Backend -> CBool -> Ptr Atom -> CSize -> Ptr Literal -> CSize -> m CBool+backendRule a b c d e f = liftIO $ backendRuleFFI a b c d e f++backendWeightRule :: MonadIO m => Backend -> CBool -> Ptr Atom -> CSize -> Weight -> Ptr WeightedLiteral -> CSize -> m CBool+backendWeightRule a b c d e f g = liftIO $ backendWeightRuleFFI a b c d e f g++backendMinimize :: MonadIO m => Backend -> Weight -> Ptr WeightedLiteral -> CSize -> m CBool+backendMinimize a b c d = liftIO $ backendMinimizeFFI a b c d++backendProject :: MonadIO m => Backend -> Ptr Atom -> CSize -> m CBool+backendProject a b c = liftIO $ backendProjectFFI a b c++backendExternal :: MonadIO m => Backend -> Atom -> ExternalType -> m CBool+backendExternal a b c = liftIO $ backendExternalFFI a b c ++backendAssume :: MonadIO m => Backend -> Ptr Literal -> CSize -> m CBool+backendAssume a b c = liftIO $ backendAssumeFFI a b c++backendHeuristic :: MonadIO m => Backend -> Atom -> HeuristicType -> CInt -> CUInt -> Ptr Literal -> CSize -> m CBool+backendHeuristic a b c d e f g = liftIO $ backendHeuristicFFI a b c d e f g++backendAcycEdge :: MonadIO m => Backend -> CInt -> CInt -> Ptr Literal -> CSize -> m CBool+backendAcycEdge a b c d e = liftIO $ backendAcycEdgeFFI a b c d e++backendAddAtom :: MonadIO m => Backend -> Ptr Atom -> m CBool+backendAddAtom a b = liftIO $ backendAddAtomFFI a b++programBuilderBegin :: MonadIO m => ProgramBuilder -> m CBool+programBuilderBegin a = liftIO $ programBuilderBeginFFI a++programBuilderAdd :: MonadIO m => ProgramBuilder -> Ptr AstStatement -> m CBool+programBuilderAdd a b = liftIO $ programBuilderAddFFI a b++programBuilderEnd :: MonadIO m => ProgramBuilder -> m CBool+programBuilderEnd a = liftIO $ programBuilderEndFFI a
+ src/Clingo/Raw/Propagation.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Propagation+(+    -- * Initialization+    propagateInitSolverLiteral,+    propagateInitAddWatch,+    propagateInitSymbolicAtoms,+    propagateInitTheoryAtoms,+    propagateInitNumberOfThreads,++    -- * Assignment+    assignmentDecisionLevel,+    assignmentHasConflict,+    assignmentHasLiteral,+    assignmentLevel,+    assignmentDecision,+    assignmentIsFixed,+    assignmentIsTrue,+    assignmentIsFalse,+    assignmentTruthValue,++    -- * Propagation+    propagateControlThreadId,+    propagateControlAssignment,+    propagateControlAddLiteral,+    propagateControlAddWatch,+    propagateControlHasWatch,+    propagateControlRemoveWatch,+    propagateControlAddClause,+    propagateControlPropagate+)+where++import Control.Monad.IO.Class+import Clingo.Raw.Enums+import Clingo.Raw.Types+import Foreign+import Foreign.C++foreign import ccall "clingo.h clingo_propagate_init_solver_literal" propagateInitSolverLiteralFFI ::+    PropagateInit -> Literal -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_propagate_init_add_watch" propagateInitAddWatchFFI ::+    PropagateInit -> Literal -> IO CBool+foreign import ccall "clingo.h clingo_propagate_init_symbolic_atoms" propagateInitSymbolicAtomsFFI ::+    PropagateInit -> Ptr SymbolicAtoms -> IO CBool+foreign import ccall "clingo.h clingo_propagate_init_theory_atoms" propagateInitTheoryAtomsFFI ::+    PropagateInit -> Ptr TheoryAtoms -> IO CBool+foreign import ccall "clingo.h clingo_propagate_init_number_of_threads" propagateInitNumberOfThreadsFFI ::+    PropagateInit -> IO CInt+foreign import ccall "clingo.h clingo_assignment_decision_level" assignmentDecisionLevelFFI ::+    Assignment -> IO Word32+foreign import ccall "clingo.h clingo_assignment_has_conflict" assignmentHasConflictFFI ::+    Assignment -> IO CBool+foreign import ccall "clingo.h clingo_assignment_has_literal" assignmentHasLiteralFFI ::+    Assignment -> Literal -> IO CBool+foreign import ccall "clingo.h clingo_assignment_level" assignmentLevelFFI ::+    Assignment -> Literal -> Ptr Word32 -> IO CBool+foreign import ccall "clingo.h clingo_assignment_decision" assignmentDecisionFFI ::+    Assignment -> Word32 -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_assignment_is_fixed" assignmentIsFixedFFI ::+    Assignment -> Literal -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_assignment_is_true" assignmentIsTrueFFI ::+    Assignment -> Literal -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_assignment_is_false" assignmentIsFalseFFI ::+    Assignment -> Literal -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_assignment_truth_value" assignmentTruthValueFFI ::+    Assignment -> Literal -> Ptr TruthValue -> IO CBool+foreign import ccall "clingo.h clingo_propagate_control_thread_id" propagateControlThreadIdFFI ::+    PropagateControl -> IO Identifier+foreign import ccall "clingo.h clingo_propagate_control_assignment" propagateControlAssignmentFFI ::+    PropagateControl -> IO Assignment+foreign import ccall "clingo.h clingo_propagate_control_add_literal" propagateControlAddLiteralFFI ::+    PropagateControl -> Ptr Literal -> IO CBool+foreign import ccall "clingo.h clingo_propagate_control_add_watch" propagateControlAddWatchFFI ::+    PropagateControl -> Literal -> IO CBool+foreign import ccall "clingo.h clingo_propagate_control_has_watch" propagateControlHasWatchFFI ::+    PropagateControl -> Literal -> IO CBool+foreign import ccall "clingo.h clingo_propagate_control_remove_watch" propagateControlRemoveWatchFFI ::+    PropagateControl -> Literal -> IO ()+foreign import ccall "clingo.h clingo_propagate_control_add_clause" propagateControlAddClauseFFI ::+    PropagateControl -> Ptr Literal -> CSize -> ClauseType -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_propagate_control_propagate" propagateControlPropagateFFI ::+    PropagateControl -> Ptr CBool -> IO CBool++propagateInitSolverLiteral :: MonadIO m => PropagateInit -> Literal -> Ptr Literal -> m CBool+propagateInitSolverLiteral a b c = liftIO $ propagateInitSolverLiteralFFI a b c++propagateInitAddWatch :: MonadIO m => PropagateInit -> Literal -> m CBool+propagateInitAddWatch a b = liftIO $ propagateInitAddWatchFFI a b++propagateInitSymbolicAtoms :: MonadIO m => PropagateInit -> Ptr SymbolicAtoms -> m CBool+propagateInitSymbolicAtoms a b = liftIO $ propagateInitSymbolicAtomsFFI a b++propagateInitTheoryAtoms :: MonadIO m => PropagateInit -> Ptr TheoryAtoms -> m CBool+propagateInitTheoryAtoms a b = liftIO $ propagateInitTheoryAtomsFFI a b++propagateInitNumberOfThreads :: MonadIO m => PropagateInit -> m CInt+propagateInitNumberOfThreads a = liftIO $ propagateInitNumberOfThreadsFFI a++assignmentDecisionLevel :: MonadIO m => Assignment -> m Word32+assignmentDecisionLevel a = liftIO $ assignmentDecisionLevelFFI a++assignmentHasConflict :: MonadIO m => Assignment -> m CBool+assignmentHasConflict a = liftIO $ assignmentHasConflictFFI a++assignmentHasLiteral :: MonadIO m => Assignment -> Literal -> m CBool+assignmentHasLiteral a b = liftIO $ assignmentHasLiteralFFI a b++assignmentLevel :: MonadIO m => Assignment -> Literal -> Ptr Word32 -> m CBool+assignmentLevel a b c = liftIO $ assignmentLevelFFI a b c++assignmentDecision :: MonadIO m => Assignment -> Word32 -> Ptr Literal -> m CBool+assignmentDecision a b c = liftIO $ assignmentDecisionFFI a b c++assignmentIsFixed :: MonadIO m => Assignment -> Literal -> Ptr CBool -> m CBool+assignmentIsFixed a b c = liftIO $ assignmentIsFixedFFI a b c++assignmentIsTrue :: MonadIO m => Assignment -> Literal -> Ptr CBool -> m CBool+assignmentIsTrue a b c = liftIO $ assignmentIsTrueFFI a b c++assignmentIsFalse :: MonadIO m => Assignment -> Literal -> Ptr CBool -> m CBool+assignmentIsFalse a b c = liftIO $ assignmentIsFalseFFI a b c++assignmentTruthValue :: MonadIO m => Assignment -> Literal -> Ptr TruthValue -> m CBool+assignmentTruthValue a b c = liftIO $ assignmentTruthValueFFI a b c++propagateControlThreadId :: MonadIO m => PropagateControl -> m Identifier+propagateControlThreadId a = liftIO $ propagateControlThreadIdFFI a++propagateControlAssignment :: MonadIO m => PropagateControl -> m Assignment+propagateControlAssignment a = liftIO $ propagateControlAssignmentFFI a++propagateControlAddLiteral :: MonadIO m => PropagateControl -> Ptr Literal -> m CBool+propagateControlAddLiteral a b = liftIO $ propagateControlAddLiteralFFI a b++propagateControlAddWatch :: MonadIO m => PropagateControl -> Literal -> m CBool+propagateControlAddWatch a b = liftIO $ propagateControlAddWatchFFI a b++propagateControlHasWatch :: MonadIO m => PropagateControl -> Literal -> m CBool+propagateControlHasWatch a b = liftIO $ propagateControlHasWatchFFI a b++propagateControlRemoveWatch :: MonadIO m => PropagateControl -> Literal -> m ()+propagateControlRemoveWatch a b = liftIO $ propagateControlRemoveWatchFFI a b++propagateControlAddClause :: MonadIO m => PropagateControl -> Ptr Literal -> CSize -> ClauseType -> Ptr CBool -> m CBool+propagateControlAddClause a b c d e = liftIO $ propagateControlAddClauseFFI a b c d e++propagateControlPropagate :: MonadIO m => PropagateControl -> Ptr CBool -> m CBool+propagateControlPropagate a b = liftIO $ propagateControlPropagateFFI a b
+ src/Clingo/Raw/Solving.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Solving+(+    solveHandleGet,+    solveHandleWait,+    solveHandleModel,+    solveHandleResume,+    solveHandleCancel,+    solveHandleClose+)+where++import Control.Monad.IO.Class++import Foreign+import Foreign.C.Types++import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_solve_handle_get" +                     solveHandleGetFFI ::+    SolveHandle -> Ptr SolveResult -> IO CBool+foreign import ccall "clingo.h clingo_solve_handle_wait"+                     solveHandleWaitFFI ::+    SolveHandle -> CDouble -> Ptr CBool -> IO ()+foreign import ccall "clingo.h clingo_solve_handle_model"+                     solveHandleModelFFI ::+    SolveHandle -> Ptr Model -> IO CBool+foreign import ccall "clingo.h clingo_solve_handle_resume"+                     solveHandleResumeFFI ::+    SolveHandle -> IO CBool+foreign import ccall "clingo.h clingo_solve_handle_cancel"+                     solveHandleCancelFFI ::+    SolveHandle -> IO CBool+foreign import ccall "clingo.h clingo_solve_handle_close"+                     solveHandleCloseFFI ::+    SolveHandle -> IO CBool++solveHandleGet :: MonadIO m => SolveHandle -> Ptr SolveResult -> m CBool+solveHandleGet a b = liftIO $ solveHandleGetFFI a b++solveHandleWait :: MonadIO m => SolveHandle -> CDouble -> Ptr CBool -> m ()+solveHandleWait a b c = liftIO $ solveHandleWaitFFI a b c++solveHandleModel :: MonadIO m => SolveHandle -> Ptr Model -> m CBool+solveHandleModel a b = liftIO $ solveHandleModelFFI a b++solveHandleResume :: MonadIO m => SolveHandle -> m CBool+solveHandleResume a = liftIO $ solveHandleResumeFFI a++solveHandleCancel :: MonadIO m => SolveHandle -> m CBool+solveHandleCancel a = liftIO $ solveHandleCancelFFI a++solveHandleClose :: MonadIO m => SolveHandle -> m CBool+solveHandleClose a = liftIO $ solveHandleCloseFFI a
+ src/Clingo/Raw/Statistics.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Statistics+(+    statisticsRoot,+    statisticsType,++    -- * Array Access+    statisticsArraySize,+    statisticsArrayAt,++    -- * Map Access+    statisticsMapSize,+    statisticsMapSubkeyName,+    statisticsMapAt,++    -- * Value Access+    statisticsValueGet+)+where++import Control.Monad.IO.Class+import Foreign+import Foreign.C++import Clingo.Raw.Enums+import Clingo.Raw.Types++foreign import ccall "clingo.h clingo_statistics_root" statisticsRootFFI ::+    Statistics -> Ptr Word64 -> IO CBool+foreign import ccall "clingo.h clingo_statistics_type" statisticsTypeFFI ::+    Statistics -> Word64 -> Ptr StatisticsType -> IO CBool+foreign import ccall "clingo.h clingo_statistics_array_size" +    statisticsArraySizeFFI :: Statistics -> Word64 -> Ptr Word64 -> IO CBool+foreign import ccall "clingo.h clingo_statistics_array_at" +    statisticsArrayAtFFI :: Statistics -> Word64 -> CSize -> Ptr Word64+                           -> IO CBool+foreign import ccall "clingo.h clingo_statistics_map_size" +    statisticsMapSizeFFI :: Statistics -> Word64 -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_statistics_map_subkey_name" +    statisticsMapSubkeyNameFFI :: Statistics -> Word64 -> CSize +                               -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_statistics_map_at" statisticsMapAtFFI ::+    Statistics -> Word64 -> CString -> Ptr Word64 -> IO CBool+foreign import ccall "clingo.h clingo_statistics_value_get" +    statisticsValueGetFFI :: Statistics -> Word64 -> Ptr CDouble -> IO CBool++statisticsRoot :: MonadIO m => Statistics -> Ptr Word64 -> m CBool+statisticsRoot a b = liftIO $ statisticsRootFFI a b++statisticsType :: MonadIO m => Statistics -> Word64 -> Ptr StatisticsType +               -> m CBool+statisticsType a b c = liftIO $ statisticsTypeFFI a b c++statisticsArraySize :: MonadIO m => Statistics -> Word64 -> Ptr Word64 +                    -> m CBool+statisticsArraySize a b c = liftIO $ statisticsArraySizeFFI a b c++statisticsArrayAt :: MonadIO m => Statistics -> Word64 -> CSize +                  -> Ptr Word64 -> m CBool+statisticsArrayAt a b c d = liftIO $ statisticsArrayAtFFI a b c d++statisticsMapSize :: MonadIO m => Statistics -> Word64 -> Ptr CSize +                  -> m CBool+statisticsMapSize a b c = liftIO $ statisticsMapSizeFFI a b c++statisticsMapSubkeyName :: MonadIO m => Statistics -> Word64 -> CSize +                        -> Ptr CString -> m CBool+statisticsMapSubkeyName a b c d = liftIO $ statisticsMapSubkeyNameFFI a b c d++statisticsMapAt :: MonadIO m => Statistics -> Word64 -> CString +                -> Ptr Word64 -> m CBool+statisticsMapAt a b c d = liftIO $ statisticsMapAtFFI a b c d++statisticsValueGet :: MonadIO m => Statistics -> Word64 -> Ptr CDouble+                   -> m CBool+statisticsValueGet a b c = liftIO $ statisticsValueGetFFI a b c
+ src/Clingo/Raw/Symbol.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Clingo.Raw.Symbol+(+    addString,+    parseTerm,++    -- * Signatures+    signatureCreate,+    signatureName,+    signatureArity,+    signatureIsPositive,+    signatureIsNegative,+    signatureIsEqualTo,+    signatureIsLessThan,+    signatureHash,++    -- * Symbol construction+    symbolCreateNumber,+    symbolCreateSupremum,+    symbolCreateInfimum,+    symbolCreateString,+    symbolCreateId,+    symbolCreateFunction,++    -- * Symbol inspection+    symbolNumber,+    symbolName,+    symbolString,+    symbolIsPositive,+    symbolIsNegative,+    symbolArguments,+    symbolType,+    symbolToStringSize,+    symbolToString,++    -- * Symbol comparison+    symbolIsEqualTo,+    symbolIsLessThan,+    symbolHash+)+where++import Control.Monad.IO.Class+import Foreign+import Foreign.C+import Clingo.Raw.Types+import Clingo.Raw.Enums++foreign import ccall "clingo.h clingo_add_string" addStringFFI ::+    CString -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_parse_term" parseTermFFI ::+    CString -> FunPtr (Logger a) -> Ptr a -> CUInt -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_signature_create" signatureCreateFFI ::+    CString -> Word32 -> CBool -> Ptr Signature -> IO CBool+foreign import ccall "clingo.h clingo_signature_name" signatureNameFFI ::+    Signature -> CString+foreign import ccall "clingo.h clingo_signature_arity" signatureArityFFI ::+    Signature -> Word32+foreign import ccall "clingo.h clingo_signature_is_positive" +    signatureIsPositiveFFI :: Signature -> CBool+foreign import ccall "clingo.h clingo_signature_is_negative" +    signatureIsNegativeFFI :: Signature -> CBool+foreign import ccall "clingo.h clingo_signature_is_equal_to" +    signatureIsEqualToFFI :: Signature -> Signature -> CBool+foreign import ccall "clingo.h clingo_signature_is_less_than" +    signatureIsLessThanFFI :: Signature -> Signature -> CBool+foreign import ccall "clingo.h clingo_signature_hash" signatureHashFFI ::+    Signature -> CSize+foreign import ccall "clingo.h clingo_symbol_create_number" +    symbolCreateNumberFFI :: CInt -> Ptr Symbol -> IO ()+foreign import ccall "clingo.h clingo_symbol_create_supremum" +    symbolCreateSupremumFFI :: Ptr Symbol -> IO ()+foreign import ccall "clingo.h clingo_symbol_create_infimum" +    symbolCreateInfimumFFI :: Ptr Symbol -> IO ()+foreign import ccall "clingo.h clingo_symbol_create_string" +    symbolCreateStringFFI :: CString -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_symbol_create_id" symbolCreateIdFFI ::+    CString -> CBool -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_symbol_create_function" +    symbolCreateFunctionFFI :: CString -> Ptr Symbol -> CSize -> CBool +                            -> Ptr Symbol -> IO CBool+foreign import ccall "clingo.h clingo_symbol_number" symbolNumberFFI ::+    Symbol -> Ptr CInt -> IO CBool+foreign import ccall "clingo.h clingo_symbol_name" symbolNameFFI ::+    Symbol -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_symbol_string" symbolStringFFI ::+    Symbol -> Ptr CString -> IO CBool+foreign import ccall "clingo.h clingo_symbol_is_positive" symbolIsPositiveFFI ::+    Symbol -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_symbol_is_negative" symbolIsNegativeFFI ::+    Symbol -> Ptr CBool -> IO CBool+foreign import ccall "clingo.h clingo_symbol_arguments" symbolArgumentsFFI ::+    Symbol -> Ptr (Ptr Symbol) -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_symbol_type" symbolTypeFFI ::+    Symbol -> SymbolType+foreign import ccall "clingo.h clingo_symbol_to_string_size" +    symbolToStringSizeFFI :: Symbol -> Ptr CSize -> IO CBool+foreign import ccall "clingo.h clingo_symbol_to_string" +    symbolToStringFFI :: Symbol -> Ptr CChar -> CSize -> IO CBool+foreign import ccall "clingo.h clingo_symbol_is_equal_to" symbolIsEqualToFFI ::+    Symbol -> Symbol -> CBool+foreign import ccall "clingo.h clingo_symbol_is_less_than" +    symbolIsLessThanFFI :: Symbol -> Symbol -> CBool+foreign import ccall "clingo.h clingo_symbol_hash" symbolHashFFI ::+    Symbol -> CSize++addString :: MonadIO m => CString -> Ptr CString -> m CBool+addString a b = liftIO $ addStringFFI a b++parseTerm :: MonadIO m => CString -> FunPtr (Logger a) -> Ptr a -> CUInt +                       -> Ptr Symbol -> m CBool+parseTerm a b c d e = liftIO $ parseTermFFI a b c d e++signatureCreate :: MonadIO m => CString -> Word32 -> CBool -> Ptr Signature +                             -> m CBool+signatureCreate a b c d = liftIO $ signatureCreateFFI a b c d++signatureName :: Signature -> CString+signatureName = signatureNameFFI++signatureArity :: Signature -> Word32+signatureArity = signatureArityFFI++signatureIsPositive :: Signature -> CBool+signatureIsPositive = signatureIsPositiveFFI++signatureIsNegative :: Signature -> CBool+signatureIsNegative = signatureIsNegativeFFI++signatureIsEqualTo :: Signature -> Signature -> CBool+signatureIsEqualTo = signatureIsEqualToFFI++signatureIsLessThan :: Signature -> Signature -> CBool+signatureIsLessThan = signatureIsLessThanFFI++signatureHash :: Signature -> CSize+signatureHash = signatureHashFFI++symbolCreateNumber :: MonadIO m => CInt -> Ptr Symbol -> m ()+symbolCreateNumber a b = liftIO $ symbolCreateNumberFFI a b++symbolCreateSupremum :: MonadIO m => Ptr Symbol -> m ()+symbolCreateSupremum a = liftIO $ symbolCreateSupremumFFI a++symbolCreateInfimum :: MonadIO m => Ptr Symbol -> m ()+symbolCreateInfimum a = liftIO $ symbolCreateInfimumFFI a++symbolCreateString :: MonadIO m => CString -> Ptr Symbol -> m CBool+symbolCreateString a b = liftIO $ symbolCreateStringFFI a b++symbolCreateId :: MonadIO m => CString -> CBool -> Ptr Symbol -> m CBool+symbolCreateId a b c = liftIO $ symbolCreateIdFFI a b c++symbolCreateFunction :: MonadIO m => CString -> Ptr Symbol -> CSize -> CBool +                                  -> Ptr Symbol -> m CBool+symbolCreateFunction a b c d e = liftIO $ symbolCreateFunctionFFI a b c d e++symbolNumber :: MonadIO m => Symbol -> Ptr CInt -> m CBool+symbolNumber a b = liftIO $ symbolNumberFFI a b++symbolName :: MonadIO m => Symbol -> Ptr CString -> m CBool+symbolName a b = liftIO $ symbolNameFFI a b++symbolString :: MonadIO m => Symbol -> Ptr CString -> m CBool+symbolString a b = liftIO $ symbolStringFFI a b++symbolIsPositive :: MonadIO m => Symbol -> Ptr CBool -> m CBool+symbolIsPositive a b = liftIO $ symbolIsPositiveFFI a b++symbolIsNegative :: MonadIO m => Symbol -> Ptr CBool -> m CBool+symbolIsNegative a b = liftIO $ symbolIsNegativeFFI a b++symbolArguments :: MonadIO m => Symbol -> Ptr (Ptr Symbol) -> Ptr CSize +                             -> m CBool+symbolArguments a b c = liftIO $ symbolArgumentsFFI a b c++symbolType :: Symbol -> SymbolType+symbolType = symbolTypeFFI++symbolToStringSize :: MonadIO m => Symbol -> Ptr CSize -> m CBool+symbolToStringSize a b = liftIO $ symbolToStringSizeFFI a b++symbolToString :: MonadIO m => Symbol -> Ptr CChar -> CSize -> m CBool+symbolToString a b c = liftIO $ symbolToStringFFI a b c++symbolIsEqualTo :: Symbol -> Symbol -> CBool+symbolIsEqualTo = symbolIsEqualToFFI++symbolIsLessThan :: Symbol -> Symbol -> CBool+symbolIsLessThan = symbolIsLessThanFFI++symbolHash :: Symbol -> CSize+symbolHash = symbolHashFFI
+ src/Clingo/Raw/Types.hsc view
@@ -0,0 +1,397 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Clingo.Raw.Types+(+    CBool,++    -- * Basic types+    Literal,+    Atom,+    Identifier,+    Weight,+    Logger,+    mkCallbackLogger,+    Location (..),++    -- * Symbols+    Signature,+    Symbol,+    SymbolicLiteral (..),++    -- * Model and Solving+    Model (..),+    SolveHandle(..),+    SolveControl (..),++    -- * Symbolic and Theory Atoms+    SymbolicAtoms (..),+    SymbolicAtomIterator,+    TheoryAtoms (..),++    -- * Propagators+    PropagateInit (..),+    Assignment (..),+    PropagateControl (..),+    CallbackPropagatorInit,+    mkCallbackPropagatorInit,+    CallbackPropagatorPropagate,+    mkCallbackPropagatorPropagate,+    CallbackPropagatorUndo,+    mkCallbackPropagatorUndo,+    CallbackPropagatorCheck,+    mkCallbackPropagatorCheck,+    Propagator (..),++    -- * Program Builder+    WeightedLiteral (..),+    Backend (..),+    ProgramBuilder (..),++    -- * Configuration & Statistics+    Configuration (..),+    Statistics (..),++    -- * Program Inspection+    GroundProgramObserver (..),+    mkGpoInitProgram,+    mkGpoBeginStep,+    mkGpoEndStep,+    mkGpoRule,+    mkGpoWeightRule,+    mkGpoMinimize,+    mkGpoProject,+    mkGpoExternal,+    mkGpoAssume,+    mkGpoHeuristic,+    mkGpoAcycEdge,+    mkGpoTheoryTermNum,+    mkGpoTheoryTermStr,+    mkGpoTheoryTermCmp,+    mkGpoTheoryElement,+    mkGpoTheoryAtom,+    mkGpoTheoryAtomGrd,++    -- * Control+    Control (..),+    Part (..),+    CallbackSymbol,+    mkCallbackSymbol,+    getCallbackSymbol,+    CallbackGround,+    mkCallbackGround,+    CallbackEvent,+    mkCallbackEvent,+    CallbackFinish,+    mkCallbackFinish+)+where++import Data.Int+import Data.Word+import Foreign+import Foreign.C++import Clingo.Raw.Enums++#include <clingo.h>++type CBool = #type bool++type Literal = #type clingo_literal_t+type Atom = #type clingo_atom_t+type Identifier = #type clingo_id_t+type Weight = #type clingo_weight_t++type Logger a = ClingoWarning -> Ptr CChar -> Ptr a -> IO ()++foreign import ccall "wrapper" mkCallbackLogger ::+    Logger a -> IO (FunPtr (Logger a))++data Location = Location+    { locBeginFile :: CString+    , locEndFile   :: CString+    , locBeginLine :: #type size_t+    , locEndLine   :: #type size_t+    , locBeginCol  :: #type size_t+    , locEndCol    :: #type size_t }+    deriving (Eq, Show)++instance Storable Location where+    sizeOf _ = #{size clingo_location_t}+    alignment = sizeOf++    peek p = Location +        <$> (#{peek clingo_location_t, begin_file} p)+        <*> (#{peek clingo_location_t, end_file} p)+        <*> (#{peek clingo_location_t, begin_line} p)+        <*> (#{peek clingo_location_t, end_line} p)+        <*> (#{peek clingo_location_t, begin_column} p)+        <*> (#{peek clingo_location_t, end_column} p)++    poke p l = do+        (#poke clingo_location_t, begin_file) p (locBeginFile l)+        (#poke clingo_location_t, end_file) p (locEndFile l)+        (#poke clingo_location_t, begin_line) p (locBeginLine l)+        (#poke clingo_location_t, end_line) p (locEndLine l)+        (#poke clingo_location_t, begin_column) p (locBeginCol l)+        (#poke clingo_location_t, end_column) p (locEndCol l)++type Signature = #type clingo_signature_t+type Symbol = #type clingo_symbol_t++data SymbolicLiteral = SymbolicLiteral+    { slitSymbol   :: Symbol+    , slitPositive :: CBool }++instance Storable SymbolicLiteral where+    sizeOf _ = #{size clingo_symbolic_literal_t}+    alignment = sizeOf+    peek p = SymbolicLiteral+         <$> (#{peek clingo_symbolic_literal_t, symbol} p)+         <*> (#{peek clingo_symbolic_literal_t, positive} p)++    poke p lit = do+        (#poke clingo_symbolic_literal_t, symbol) p (slitSymbol lit)+        (#poke clingo_symbolic_literal_t, positive) p (slitPositive lit)++newtype SolveHandle = SolveHandle (Ptr SolveHandle) deriving Storable+newtype SolveControl = SolveControl (Ptr SolveControl) deriving Storable+newtype Model = Model (Ptr Model) deriving Storable+newtype SymbolicAtoms = SymbolicAtoms (Ptr SymbolicAtoms) deriving Storable++type SymbolicAtomIterator = #type clingo_symbolic_atom_iterator_t++newtype TheoryAtoms = TheoryAtoms (Ptr TheoryAtoms) deriving Storable+newtype PropagateInit = PropagateInit (Ptr PropagateInit) deriving Storable+newtype Assignment = Assignment (Ptr Assignment) deriving Storable+newtype PropagateControl = PropagateControl (Ptr PropagateControl) +    deriving Storable++type CallbackPropagatorInit a = +    PropagateInit -> Ptr a -> IO (CBool)++foreign import ccall "wrapper" mkCallbackPropagatorInit ::+    CallbackPropagatorInit a -> IO (FunPtr (CallbackPropagatorInit a))++type CallbackPropagatorPropagate a = +    PropagateControl -> Ptr Literal -> CSize -> Ptr a -> IO CBool++foreign import ccall "wrapper" mkCallbackPropagatorPropagate ::+    CallbackPropagatorPropagate a -> IO (FunPtr (CallbackPropagatorPropagate a))++type CallbackPropagatorUndo a = +    PropagateControl -> Ptr Literal -> CSize -> Ptr a -> IO CBool++foreign import ccall "wrapper" mkCallbackPropagatorUndo ::+    CallbackPropagatorUndo a -> IO (FunPtr (CallbackPropagatorUndo a))++type CallbackPropagatorCheck a = +    PropagateControl -> Ptr a -> IO CBool++foreign import ccall "wrapper" mkCallbackPropagatorCheck ::+    CallbackPropagatorCheck a -> IO (FunPtr (CallbackPropagatorCheck a))++data Propagator a = Propagator+    { propagatorInit      :: FunPtr (CallbackPropagatorInit a)+    , propagatorPropagate :: FunPtr (CallbackPropagatorPropagate a)+    , propagatorUndo      :: FunPtr (CallbackPropagatorUndo a)+    , propagatorCheck     :: FunPtr (CallbackPropagatorCheck a)+    }++instance Storable (Propagator a) where+    sizeOf _ = #{size clingo_propagator_t}+    alignment = sizeOf+    peek p = Propagator +         <$> (#{peek clingo_propagator_t, init} p)+         <*> (#{peek clingo_propagator_t, propagate} p)+         <*> (#{peek clingo_propagator_t, undo} p)+         <*> (#{peek clingo_propagator_t, check} p)++    poke p prop = do+        (#poke clingo_propagator_t, init) p (propagatorInit prop)+        (#poke clingo_propagator_t, propagate) p (propagatorPropagate prop)+        (#poke clingo_propagator_t, undo) p (propagatorUndo prop)+        (#poke clingo_propagator_t, check) p (propagatorCheck prop)++data WeightedLiteral = WeightedLiteral+    { wlLiteral :: Literal+    , wlWeight  :: Weight+    }++instance Storable WeightedLiteral where+    sizeOf _ = #{size clingo_weighted_literal_t}+    alignment = sizeOf+    peek p = WeightedLiteral+         <$> (#{peek clingo_weighted_literal_t, literal} p)+         <*> (#{peek clingo_weighted_literal_t, weight} p)++    poke p wl = do+        (#poke clingo_weighted_literal_t, literal) p (wlLiteral wl)+        (#poke clingo_weighted_literal_t, weight) p (wlWeight wl)++newtype Backend = Backend (Ptr Backend) deriving Storable+newtype Configuration = Configuration (Ptr Configuration) deriving Storable+newtype Statistics = Statistics (Ptr Statistics) deriving Storable+newtype ProgramBuilder = ProgramBuilder (Ptr ProgramBuilder) deriving Storable++data GroundProgramObserver a = GroundProgramObserver+    { gpoInitProgram   :: FunPtr (CBool -> Ptr a -> IO CBool)+    , gpoBeginStep     :: FunPtr (Ptr a -> IO CBool)+    , gpoEndStep       :: FunPtr (Ptr a -> IO CBool)+    , gpoRule          :: FunPtr (CBool -> Ptr Atom -> CSize +                                               -> Ptr Literal -> CSize +                                               -> Ptr a -> IO CBool)+    , gpoWeightRule    :: FunPtr (CBool -> Ptr Atom -> CSize -> Weight +                                               -> Ptr WeightedLiteral -> CSize +                                               -> Ptr a -> IO CBool)+    , gpoMinimize      :: FunPtr (Weight -> Ptr WeightedLiteral -> CSize +                                         -> Ptr a -> IO CBool)+    , gpoProject       :: FunPtr (Ptr Atom -> CSize -> Ptr a -> IO CBool)+    , gpoExternal      :: FunPtr (Atom -> ExternalType -> Ptr a -> IO CBool)+    , gpoAssume        :: FunPtr (Ptr Literal -> CSize -> Ptr a -> IO CBool)+    , gpoHeuristic     :: FunPtr (Atom -> HeuristicType -> CInt +                                       -> CUInt -> Ptr Literal -> CSize +                                       -> Ptr a -> IO CBool)+    , gpoAcycEdge      :: FunPtr (CInt -> CInt -> Ptr Literal -> CSize +                                       -> Ptr a -> IO CBool)+    , gpoTheoryTermNum :: FunPtr (Identifier -> CInt -> Ptr a -> IO CBool)+    , gpoTheoryTermStr :: FunPtr (Identifier -> Ptr CChar -> Ptr a -> IO CBool)+    , gpoTheoryTermCmp :: FunPtr (Identifier -> CInt -> Ptr Identifier -> CSize +                                             -> Ptr a -> IO CBool)+    , gpoTheoryElement :: FunPtr (Identifier -> Ptr Identifier -> CSize +                                             -> Ptr Literal -> CSize -> Ptr a +                                             -> IO CBool)+    , gpoTheoryAtom    :: FunPtr (Identifier -> Identifier -> Ptr Identifier +                                             -> CSize -> IO CBool)+    , gpoTheoryAtomGrd :: FunPtr (Identifier -> Identifier -> Ptr Identifier +                                             -> CSize -> Identifier +                                             -> Identifier -> Ptr a +                                             -> IO CBool)+    }++foreign import ccall "wrapper" mkGpoInitProgram :: +    (CBool -> Ptr a -> IO CBool) -> IO (FunPtr (CBool -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoBeginStep :: +    (Ptr a -> IO CBool) -> IO (FunPtr (Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoEndStep ::+    (Ptr a -> IO CBool) -> IO (FunPtr (Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoRule ::+    (CBool -> Ptr Atom -> CSize -> Ptr Literal -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (CBool -> Ptr Atom -> CSize -> Ptr Literal -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoWeightRule ::+    (CBool -> Ptr Atom -> CSize -> Weight -> Ptr WeightedLiteral -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (CBool -> Ptr Atom -> CSize -> Weight -> Ptr WeightedLiteral -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoMinimize ::+    (Weight -> Ptr WeightedLiteral -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Weight -> Ptr WeightedLiteral -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoProject ::+    (Ptr Atom -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Ptr Atom -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoExternal ::+    (Atom -> ExternalType -> Ptr a -> IO CBool) -> IO (FunPtr (Atom -> ExternalType -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoAssume ::+    (Ptr Literal -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Ptr Literal -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoHeuristic ::+    (Atom -> HeuristicType -> CInt -> CUInt -> Ptr Literal -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Atom -> HeuristicType -> CInt -> CUInt -> Ptr Literal -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoAcycEdge ::+    (CInt -> CInt -> Ptr Literal -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (CInt -> CInt -> Ptr Literal -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryTermNum ::+    (Identifier -> CInt -> Ptr a -> IO CBool) -> IO (FunPtr (Identifier -> CInt -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryTermStr ::+    (Identifier -> Ptr CChar -> Ptr a -> IO CBool) -> IO (FunPtr (Identifier -> Ptr CChar -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryTermCmp ::+    (Identifier -> CInt -> Ptr Identifier -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Identifier -> CInt -> Ptr Identifier -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryElement ::+    (Identifier -> Ptr Identifier -> CSize -> Ptr Literal -> CSize -> Ptr a -> IO CBool) -> IO (FunPtr (Identifier -> Ptr Identifier -> CSize -> Ptr Literal -> CSize -> Ptr a -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryAtom ::+    (Identifier -> Identifier -> Ptr Identifier -> CSize -> IO CBool) -> IO (FunPtr (Identifier -> Identifier -> Ptr Identifier -> CSize -> IO CBool))+foreign import ccall "wrapper" mkGpoTheoryAtomGrd ::+    (Identifier -> Identifier -> Ptr Identifier -> CSize -> Identifier -> Identifier -> Ptr a -> IO CBool) -> IO (FunPtr (Identifier -> Identifier -> Ptr Identifier -> CSize -> Identifier -> Identifier -> Ptr a -> IO CBool))++instance Storable (GroundProgramObserver a) where+    sizeOf _ = #{size clingo_ground_program_observer_t}+    alignment = sizeOf+    peek p = GroundProgramObserver+        <$> (#{peek clingo_ground_program_observer_t, init_program} p)+        <*> (#{peek clingo_ground_program_observer_t, begin_step} p)+        <*> (#{peek clingo_ground_program_observer_t, end_step} p)+        <*> (#{peek clingo_ground_program_observer_t, rule} p)+        <*> (#{peek clingo_ground_program_observer_t, weight_rule} p)+        <*> (#{peek clingo_ground_program_observer_t, minimize} p)+        <*> (#{peek clingo_ground_program_observer_t, project} p)+        <*> (#{peek clingo_ground_program_observer_t, external} p)+        <*> (#{peek clingo_ground_program_observer_t, assume} p)+        <*> (#{peek clingo_ground_program_observer_t, heuristic} p)+        <*> (#{peek clingo_ground_program_observer_t, acyc_edge} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_term_number} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_term_string} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_term_compound} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_element} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_atom} p)+        <*> (#{peek clingo_ground_program_observer_t, theory_atom_with_guard} p)++    poke p g = do+        (#poke clingo_ground_program_observer_t, init_program) p +            (gpoInitProgram g)+        (#poke clingo_ground_program_observer_t, begin_step) p (gpoBeginStep g)+        (#poke clingo_ground_program_observer_t, end_step) p (gpoEndStep g)+        (#poke clingo_ground_program_observer_t, rule) p (gpoRule g)+        (#poke clingo_ground_program_observer_t, weight_rule) p +            (gpoWeightRule g)+        (#poke clingo_ground_program_observer_t, minimize) p (gpoMinimize g)+        (#poke clingo_ground_program_observer_t, project) p (gpoProject g)+        (#poke clingo_ground_program_observer_t, external) p (gpoExternal g)+        (#poke clingo_ground_program_observer_t, assume) p (gpoAssume g)+        (#poke clingo_ground_program_observer_t, heuristic) p (gpoHeuristic g)+        (#poke clingo_ground_program_observer_t, acyc_edge) p (gpoAcycEdge g)+        (#poke clingo_ground_program_observer_t, theory_term_number) p +            (gpoTheoryTermNum g)+        (#poke clingo_ground_program_observer_t, theory_term_string) p +            (gpoTheoryTermStr g)+        (#poke clingo_ground_program_observer_t, theory_term_compound) p +            (gpoTheoryTermCmp g)+        (#poke clingo_ground_program_observer_t, theory_element) p +            (gpoTheoryElement g)+        (#poke clingo_ground_program_observer_t, theory_atom) p +            (gpoTheoryAtom g)+        (#poke clingo_ground_program_observer_t, theory_atom_with_guard) p +            (gpoTheoryAtomGrd g)++newtype Control = Control (Ptr Control) deriving Storable++data Part = Part+    { partName   :: CString+    , partParams :: Ptr Symbol+    , partSize   :: CSize+    }++instance Storable Part where+    sizeOf _ = #{size clingo_part_t}+    alignment = sizeOf+    peek p = Part+         <$> (#{peek clingo_part_t, name} p)+         <*> (#{peek clingo_part_t, params} p)+         <*> (#{peek clingo_part_t, size} p)++    poke p part = do+         (#poke clingo_part_t, name) p (partName part)+         (#poke clingo_part_t, params) p (partParams part)+         (#poke clingo_part_t, size) p (partSize part)++type CallbackSymbol a = Ptr Symbol -> CSize -> Ptr a -> IO CBool+type CallbackGround a = +    Ptr Location -> Ptr CChar -> Ptr Symbol -> CSize -> Ptr a +                 -> FunPtr (CallbackSymbol a) -> Ptr a -> IO CBool+type CallbackEvent a = SolveEvent -> Ptr Model -> Ptr a -> Ptr CBool -> IO CBool+type CallbackFinish a = SolveResult -> Ptr a -> IO CBool++foreign import ccall "wrapper" mkCallbackGround ::+    CallbackGround a -> IO (FunPtr (CallbackGround a))++foreign import ccall "wrapper" mkCallbackSymbol ::+    CallbackSymbol a -> IO (FunPtr (CallbackSymbol a))++foreign import ccall "dynamic" getCallbackSymbol ::+    FunPtr (CallbackSymbol a) -> CallbackSymbol a++foreign import ccall "wrapper" mkCallbackFinish ::+    CallbackFinish a -> IO (FunPtr (CallbackFinish a))++foreign import ccall "wrapper" mkCallbackEvent ::+    CallbackEvent a -> IO (FunPtr (CallbackEvent a))
+ src/Clingo/Solving.hs view
@@ -0,0 +1,88 @@+module Clingo.Solving+(+    ResultReady(..),+    MonadSolve(..),+    solverClose,+    allModels+)+where++import Control.Monad.IO.Class+import Control.Monad.Catch+import Clingo.Model (MonadModel)+import Clingo.Internal.Types+import Foreign.Ptr+import Foreign.Marshal.Utils+import Clingo.Internal.Utils+import qualified Clingo.Raw as Raw++data ResultReady = Ready | NotReady+    deriving (Eq, Show, Read, Ord)++toRR :: Bool -> ResultReady+toRR True  = Ready+toRR False = NotReady++class MonadModel m => MonadSolve m where+    -- | Get the next solve result.+    getResult    :: Solver s -> m s SolveResult++    -- | Get the next model if it exists.+    getModel     :: Solver s -> m s (Maybe (Model s))++    -- | Wait for the specified time to check if the result is ready.+    solverWait   :: Solver s -> Double -> m s ResultReady++    -- | Discard the last model and start search for the next.+    solverResume :: Solver s -> m s ()++    -- | Stop the running search and block until done.+    solverCancel :: Solver s -> m s ()++instance MonadSolve IOSym where+    getResult = getResult'+    getModel = getModel'+    solverWait = solverWait'+    solverResume = solverResume'+    solverCancel = solverCancel'++instance MonadSolve Clingo where+    getResult = getResult'+    getModel = getModel'+    solverWait = solverWait'+    solverResume = solverResume'+    solverCancel = solverCancel'++-- | Convenience method to get all models. Note that this is dependent on the+-- solver configuration!+allModels :: (Monad (m s), MonadSolve m) => Solver s -> m s [Model s]+allModels solver = do+    solverResume solver+    m <- getModel solver+    case m of+        Nothing -> pure []+        Just x  -> (x :) <$> allModels solver++getResult' :: (MonadThrow m, MonadIO m) => Solver s -> m SolveResult+getResult' (Solver s) = fromRawSolveResult <$> marshall1 (Raw.solveHandleGet s)++getModel' :: (MonadThrow m, MonadIO m) => Solver s -> m (Maybe (Model s))+getModel' (Solver s) = do+    m@(Raw.Model x) <- marshall1 $ Raw.solveHandleModel s+    pure $ if x == nullPtr then Nothing else Just (Model m)++solverWait' :: MonadIO m => Solver s -> Double -> m ResultReady+solverWait' (Solver s) timeout = do+    x <- marshall1V $ Raw.solveHandleWait s (realToFrac timeout)+    pure . toRR . toBool $ x++solverResume' :: (MonadThrow m, MonadIO m) => Solver s -> m ()+solverResume' (Solver s) = marshall0 $ Raw.solveHandleResume s++solverCancel' :: (MonadThrow m, MonadIO m) => Solver s -> m ()+solverCancel' (Solver s) = marshall0 $ Raw.solveHandleCancel s++-- | Stops the running search and releases the handle. Blocks until search is+-- stopped.+solverClose :: Solver s -> Clingo s ()+solverClose (Solver s) = marshall0 $ Raw.solveHandleClose s
+ src/Clingo/Statistics.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Statistics+(+    StatsTree (..),+    AMVTree (..),+    (>=>),+    fromStats,+    fromStatsMany,+    subStats+)+where++import Control.Monad+import Control.Monad.Catch+import Control.Monad.IO.Class+import Control.DeepSeq+import Data.Text (Text)++import GHC.Generics++import Clingo.Internal.Types+import Clingo.Internal.Statistics++import System.IO.Unsafe++-- | The polymorphic statistics tree.+data StatsTree v+    = SValue v+    | SMap [(Text, StatsTree v)]+    | SArray [(Int, StatsTree v)]+    deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic)++instance NFData v => NFData (StatsTree v)++getTree :: (MonadIO m, MonadThrow m) => Statistics s -> m (StatsTree Double)+getTree s = statisticsRoot s >>= liftIO . go+    where go k = unsafeInterleaveIO $ do+              t <- statisticsType s k+              case t of+                  StatsArray -> do+                      len <- statisticsArraySize s k+                      let offsets = take (fromIntegral len) [0..]+                      cs  <- mapM (go <=< statisticsArrayAt s k) offsets+                      return $ SArray (zip (map fromIntegral offsets) cs)+                  StatsMap   -> do+                      len <- statisticsMapSize s k+                      let offsets = take (fromIntegral len) [0..]+                      nms <- mapM (statisticsMapSubkeyName s k) offsets+                      cs  <- mapM (go <=< statisticsMapAt s k) nms+                      return $ SMap (zip nms cs)+                  StatsValue -> SValue <$> statisticsValueGet s k+                  _ -> error "Encountered empty statistics node"++instance AMVTree StatsTree where+    atArray i (SArray a) = lookup i a+    atArray _ _ = Nothing++    atMap i (SMap m) = lookup i m+    atMap _ _ = Nothing++    value (SValue v) = Just v+    value _          = Nothing++-- | Get a statistics value from the tree. If any lookup fails, the result will+-- be 'Nothing'. The tree will be traversed lazily, but the result is evaluated+-- before returning!+fromStats :: NFData w+          => Statistics s -> (StatsTree Double -> Maybe w) -> Clingo s (Maybe w)+fromStats s f = head <$> fromStatsMany s [f]++-- | Like 'fromTree' but supporting multiple paths.+fromStatsMany :: NFData w+              => Statistics s -> [StatsTree Double -> Maybe w] +              -> Clingo s [Maybe w]+fromStatsMany s fs = getTree s >>= \t -> return (force (fs <*> [t]))++-- | Get an entire subtree from the statistics. The entire subtree will be+-- evaluated before returning!+subStats :: NFData w+         => Statistics s -> (StatsTree Double -> Maybe (StatsTree w))+         -> Clingo s (Maybe (StatsTree w))+subStats s f = force . f <$> getTree s
+ src/Clingo/Symbol.hs view
@@ -0,0 +1,221 @@+-- | Functions for handling symbols and signatures with clingo.+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}+module Clingo.Symbol+(+    Clingo,+    ClingoWarning,+    warningString,+    Symbol,+    Location,+    Signed (..),++    -- * Symbol types+    SymbolType (..),+    symbolType,+    pattern SymInfimum,+    pattern SymNumber,+    pattern SymString,+    pattern SymFunction,+    pattern SymSupremum,++    -- ** Function symbols+    FunctionSymbol,+    functionSymbol,++    -- * Signature parsing/inspection+    Signature,+    parseTerm,++    signatureArity,+    signatureHash,+    signatureName,++    -- * Symbol and signature creation+    MonadSymbol (..),+    createId,+    +    -- * Symbol inspection+    symbolArguments,+    symbolGetArg,+    symbolHash,+    symbolName,+    symbolNumber,+    symbolString,+    prettySymbol,++    -- * Pure types+    PureSymbol (..),+    unpureSymbol,+    toPureSymbol,+    PureSignature (..),+    unpureSignature,+    toPureSignature+)+where++import Data.Maybe (fromJust)+import Data.Text (Text, unpack)+import Data.Text.Lazy (fromStrict)+import Numeric.Natural+import Foreign.C+import Foreign++import Text.PrettyPrint.Leijen.Text hiding ((<$>))++import GHC.Generics++import Clingo.Internal.Types+import Clingo.Internal.Utils+import Clingo.Internal.Symbol+import qualified Clingo.Raw as Raw++import System.IO.Unsafe++newtype SymbolType = SymbolType Raw.SymbolType+    deriving Eq++pattern SymInfimum = SymbolType Raw.SymInfimum+pattern SymNumber = SymbolType Raw.SymNumber+pattern SymString = SymbolType Raw.SymString+pattern SymFunction = SymbolType Raw.SymFunction+pattern SymSupremum = SymbolType Raw.SymSupremum++-- | Get the type of a symbol+symbolType :: Symbol s -> SymbolType+symbolType = SymbolType . symType++newtype FunctionSymbol s = FuncSym { unFuncSym :: Symbol s }+    deriving (Eq, Ord)++-- | Obtain a 'FunctionSymbol' if possible.+functionSymbol :: Symbol s -> Maybe (FunctionSymbol s)+functionSymbol s = case symbolType s of+    SymFunction -> Just $ FuncSym s+    _ -> Nothing++instance Signed (FunctionSymbol s) where+    positive s = unsafePerformIO $ +        toBool <$> marshall1 (Raw.symbolIsPositive . rawSymbol . unFuncSym $ s)+    negative s = unsafePerformIO $ +        toBool <$> marshall1 (Raw.symbolIsNegative . rawSymbol . unFuncSym $ s)++-- | Construct a symbol representing an id.+createId :: MonadSymbol m => Text -> Bool -> m s (Symbol s)+createId t = createFunction t []++-- | Parse a term in string form. This does not return an AST Term!+parseTerm :: Text                                       -- ^ Term as 'Text'+          -> Maybe (ClingoWarning -> Text -> IO ())     -- ^ Logger callback+          -> Natural                                    -- ^ Callback limit+          -> Clingo s (Symbol s)+parseTerm t logger limit = pureSymbol =<< marshall1 go+    where go x = withCString (unpack t) $ \cstr -> do+                     logCB <- maybe (pure nullFunPtr) wrapCBLogger logger+                     Raw.parseTerm cstr logCB nullPtr (fromIntegral limit) x++-- | Get the name of a signature.+signatureName :: Signature s -> Text+signatureName = sigName++-- | Get the arity of a signature.+signatureArity :: Signature s -> Natural+signatureArity = sigArity++-- | Hash a signature.+signatureHash :: Signature s -> Integer+signatureHash = sigHash++-- | Hash a symbol+symbolHash :: Symbol s -> Integer+symbolHash = symHash++-- | Obtain number from symbol. Will fail for invalid symbol types.+symbolNumber :: Symbol s -> Maybe Integer+symbolNumber = symNum++-- | Obtain the name of a symbol when possible.+symbolName :: Symbol s -> Maybe Text+symbolName = symName++-- | Obtain the string from a suitable symbol.+symbolString :: Symbol s -> Maybe Text+symbolString = symString++-- | Obtain the arguments of a symbol. May be empty.+symbolArguments :: Symbol s -> [Symbol s]+symbolArguments = symArgs++-- | Obtain the n-th argument of a symbol.+symbolGetArg :: Symbol s -> Int -> Maybe (Symbol s)+symbolGetArg s i =+    let args = symbolArguments s in+    if length args <= i then Nothing+                        else Just $ args !! i++-- | Pretty print a symbol into a 'Text'.+prettySymbol :: Symbol s -> Text+prettySymbol = symPretty++-- | 'PureSymbol' represents a completely pure Haskell alternative to the+-- handled 'Symbol' type of the clingo library.+data PureSymbol+    = PureInfimum+    | PureSupremum+    | PureNumber Integer+    | PureFunction Text [PureSymbol] Bool+    | PureString Text+    deriving (Eq, Show, Ord, Generic)++instance Pretty PureSymbol where+    pretty c = case c of+        PureInfimum -> text "inf"+        PureSupremum -> text "sup"+        PureNumber x -> pretty x+        PureFunction x vs s -> s' <+> text (fromStrict x) +                                   <> if null vs then mempty else vs'+            where s'  = if s then empty else text "not"+                  vs' = tupled (map pretty vs)+        PureString s -> text (fromStrict s)++-- | Create a 'Symbol' in the solver from a 'PureSymbol'+unpureSymbol :: (Monad (m s), MonadSymbol m) => PureSymbol -> m s (Symbol s)+unpureSymbol PureInfimum = createInfimum+unpureSymbol PureSupremum = createSupremum+unpureSymbol (PureNumber i) = createNumber i+unpureSymbol (PureFunction f as b) = +    flip (createFunction f) b =<< mapM unpureSymbol as+unpureSymbol (PureString t) = createString t++toPureSymbol :: Symbol s -> PureSymbol+toPureSymbol s = case symType s of+    Raw.SymInfimum -> PureInfimum+    Raw.SymSupremum -> PureSupremum+    Raw.SymString -> PureString (fromJust $ symbolString s)+    Raw.SymFunction -> PureFunction +        (fromJust $ symbolName s) +        (map toPureSymbol $ symbolArguments s) +        (fromJust (positive <$> functionSymbol s))+    Raw.SymNumber -> PureNumber (fromJust $ symbolNumber s)+    _ -> error "Unknown symbol type"++-- | 'PureSignature' represents a completely pure Haskell alternative to the+-- handled 'Signature' type of the clingo library.+data PureSignature = PureSignature Text Natural Bool+    deriving (Eq, Show, Ord, Generic)++instance Pretty PureSignature where+    pretty (PureSignature s a b) = +        b' <+> text (fromStrict s) <> char '/' +            <> pretty (fromIntegral a :: Integer)+        where b' = if b then empty else text "not"++-- | Create a 'Signature' in the solver from a 'PureSignature'+unpureSignature :: MonadSymbol m => PureSignature -> m s (Signature s)+unpureSignature (PureSignature t a b) = createSignature t a b++toPureSignature :: Signature s -> PureSignature+toPureSignature s = PureSignature +    (signatureName s) (signatureArity s) (positive s)