module NLP.GenI (
ProgState(..), ProgStateRef, emptyProgState,
LexicalSelector,
runGeni, simplifyResults, defaultCustomSem,
GeniResults(..),
GeniResult(..), isSuccess, GeniError(..), GeniSuccess(..),
GeniLexSel(..),
ResultType(..),
initGeni, extractResults,
lemmaSentenceString, prettyResult,
showRealisations, histogram,
getTraces,
loadEverything,
Loadable(..),
loadLexicon,
loadGeniMacros,
loadTestSuite, parseSemInput,
loadRanking, BadInputException(..),
loadFromString,
)
where
import Control.Applicative ((<$>), (<*>))
import Control.DeepSeq
import Control.Exception
import Control.Monad.Error
import Data.Binary (Binary, decodeFile)
import qualified Data.ByteString as BS
import Data.IORef (IORef, modifyIORef, readIORef)
import Data.List
import qualified Data.Map as Map
import Data.Monoid (mempty, (<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import System.CPUTime (getCPUTime)
import System.FilePath (takeExtension)
import System.IO (stderr)
import Data.FullList (fromFL)
import System.Log.Logger (debugM)
import Text.JSON
import qualified NLP.GenI.Builder as B
import NLP.GenI.Configuration
import NLP.GenI.ErrorIO
import NLP.GenI.General (eFlush, ePutStr, ePutStrLn, first3,
geniBug, histogram, mkLogname, snd3)
import NLP.GenI.GeniShow
import NLP.GenI.GeniVal
import NLP.GenI.LexicalSelection (CustomSem (..),
LexicalSelection (..),
LexicalSelector,
defaultLexicalSelector)
import NLP.GenI.Lexicon
import NLP.GenI.Morphology
import NLP.GenI.OptimalityTheory
import NLP.GenI.Parser (ParseError, geniLexicon, geniMacros,
geniMorphInfo, geniSemanticInput,
geniTagElems, geniTestSuite,
geniTestSuiteString, runParser)
import NLP.GenI.Polarity (emptyPolPaths)
import NLP.GenI.Pretty hiding ((<>))
import NLP.GenI.Semantics
import NLP.GenI.Statistics
import NLP.GenI.Tag (TagElem, idname, setTidnums,
tsemantics)
import NLP.GenI.TestSuite (TestCase (..))
import NLP.GenI.TreeSchema
import NLP.GenI.Warning
data ProgState = ProgState
{ pa :: Params
, gr :: Macros
, le :: Lexicon
, morphinf :: MorphInputFn
, traces :: [Text]
, customMorph :: Maybe MorphRealiser
}
instance HasFlags ProgState where
flags = flags . pa
onFlags f p = p { pa = onFlags f (pa p) }
type ProgStateRef = IORef ProgState
emptyProgState :: Params -> ProgState
emptyProgState args = ProgState
{ pa = args
, gr = []
, le = []
, morphinf = const Nothing
, customMorph = Nothing
, traces = []
}
loadEverything :: ProgStateRef -> CustomSem sem -> IO()
loadEverything pstRef wrangler = do
pst <- readIORef pstRef
let isMissing f = not $ hasFlag f pst
grammarType = getGrammarType (flags pst)
isNotPreanchored = grammarType /= PreAnchored
isNotPrecompiled = grammarType /= PreCompiled
useTestSuite = isMissing FromStdinFlg
&& isMissing NoLoadTestSuiteFlg
let errormsg =
concat $ intersperse ", " [ msg | (con, msg) <- errorlst, con ]
errorlst =
[ (isMissing RootFeatureFlg,
"a root feature [empty feature is fine if you are not using polarity filtering]")
, (isNotPrecompiled && isMissing MacrosFlg,
"a tree file")
, (isNotPreanchored && isMissing LexiconFlg,
"a lexicon file")
, (useTestSuite && isMissing TestSuiteFlg,
"a test suite") ]
unless (null errormsg) $ fail ("Please specify: " ++ errormsg)
case grammarType of
PreAnchored -> return ()
PreCompiled -> return ()
_ -> loadGeniMacros pstRef >> return ()
when isNotPreanchored $ loadLexicon pstRef >> return ()
loadMorphInfo pstRef
when useTestSuite $ loadTestSuite pst wrangler >> return ()
loadTraces pstRef
loadRanking pstRef
class Loadable x where
lParse :: FilePath
-> Text -> Either Text x
lSet :: x -> ProgState -> ProgState
lSummarise :: x -> String
lParseFromFile :: Loadable x => FilePath -> IO (Either Text x)
lParseFromFile f = lParse f . T.decodeUtf8 <$> BS.readFile f
lSetState :: Loadable x => ProgStateRef -> x -> IO x
lSetState pstRef x = modifyIORef pstRef (lSet x) >> return x
throwOnParseError :: String -> Either Text x -> IO x
throwOnParseError descr (Left err) = throwIO (BadInputException descr err)
throwOnParseError _ (Right p) = return p
data BadInputException = BadInputException String Text
deriving (Show, Typeable)
instance Exception BadInputException
data L a = Loadable a => L
loadOrDie :: forall f a . (Eq f, Typeable f, Loadable a)
=> L a
-> (FilePath -> f)
-> String
-> ProgStateRef
-> IO a
loadOrDie L flg descr pstRef = do
pst <- readIORef pstRef
withFlagOrDie flg pst descr $ \f -> do
v <- verbosity pstRef
x <- withLoadStatus v f descr lSummarise lParseFromFile
>>= throwOnParseError descr
>>= lSetState pstRef
return x
loadFromString :: Loadable a => ProgStateRef
-> String
-> Text
-> IO a
loadFromString pstRef descr s =
throwOnParseError descr (lParse "" s) >>= lSetState pstRef
instance Loadable Lexicon where
lParse f =
fmap toLexicon . fromParsec . runParser geniLexicon () f
where
fixEntry = finaliseVars ""
. anonymiseSingletons
. sorter
toLexicon = map fixEntry
sorter l = l { isemantics = (sortByAmbiguity . isemantics) l }
lSet x p = p { le = x }
lSummarise x = show (length x) ++ " lemmas"
instance Loadable Macros where
lParse f = fromParsec . runParser geniMacros () f
lSet x p = p { gr = x }
lSummarise x = show (length x) ++ " schemata"
loadLexicon :: ProgStateRef -> IO Lexicon
loadLexicon = loadOrDie (L :: L Lexicon) LexiconFlg "lexicon"
loadGeniMacros :: ProgStateRef -> IO Macros
loadGeniMacros pstRef = do
pst <- readIORef pstRef
withFlagOrDie MacrosFlg pst descr $ \f -> do
v <- verbosity pstRef
withLoadStatus v f descr lSummarise parse
>>= throwOnParseError "tree schemata"
>>= lSetState pstRef
where
descr = "trees"
parse = parseFromFileMaybeBinary lParseFromFile
loadOptional :: forall f a . (Eq f, Typeable f, Loadable a)
=> L a
-> (FilePath -> f)
-> String
-> ProgStateRef
-> IO ()
loadOptional L flg descr pstRef = do
pst <- readIORef pstRef
withFlagOrIgnore flg pst $ \f -> do
v <- verbosity pstRef
x <- withLoadStatus v f descr lSummarise lParseFromFile
>>= throwOnParseError descr
>>= lSetState pstRef
let _ = x :: a
return ()
newtype MorphFnL = MorphFnL MorphInputFn
instance Loadable MorphFnL where
lParse f = fmap (MorphFnL . readMorph)
. fromParsec
. runParser geniMorphInfo () f
lSet (MorphFnL x) p = p { morphinf = x }
lSummarise _ = "morphinfo"
newtype TracesL = TracesL [Text]
instance Loadable TracesL where
lParse _ = Right . TracesL . T.lines
lSet (TracesL xs) p = p { traces = xs }
lSummarise (TracesL xs) = show (length xs) ++ " traces"
instance Loadable OtRanking where
lParse _ = resultToEither2 . decode . T.unpack
lSet r p = p { pa = (pa p) { ranking = Just r } }
lSummarise _ = "ranking"
loadMorphInfo :: ProgStateRef -> IO ()
loadMorphInfo = loadOptional (L :: L MorphFnL) MorphInfoFlg "morphological info"
loadTraces :: ProgStateRef -> IO ()
loadTraces = loadOptional (L :: L TracesL) TracesFlg "traces"
loadRanking :: ProgStateRef -> IO ()
loadRanking = loadOptional (L :: L OtRanking) RankingConstraintsFlg "OT constraints"
fromParsec :: Either ParseError a -> Either Text a
fromParsec (Left err) = Left . T.pack $ show err
fromParsec (Right a) = Right a
resultToEither2 :: Result a -> Either Text a
resultToEither2 r =
case resultToEither r of
Left e -> Left (T.pack e)
Right x -> Right x
newtype TestSuiteL = TestSuiteL { fromTestSuiteL :: [TestCase SemInput] }
instance Loadable TestSuiteL where
lParse f s = fromParsec $ do
sem <- runParser geniTestSuite () f s
mStrs <- runParser geniTestSuiteString () f s
return $ TestSuiteL (zipWith cleanup sem mStrs)
where
cleanup tc str = tc
{ tcSem = first3 sortSem (tcSem tc)
, tcSemString = str
}
lSet (TestSuiteL _) p = p
lSummarise (TestSuiteL x) = show (length x) ++ " cases"
loadTestSuite :: ProgState -> CustomSem sem -> IO [TestCase sem]
loadTestSuite pst wrangler = do
withFlagOrDie flg pst descr $ \f ->
withLoadStatus v f descr summary pfile
>>= throwOnParseError descr
where
v = hasFlag VerboseModeFlg pst
pfile f = customSuiteParser wrangler f <$> readFileUtf8 f
flg = TestSuiteFlg
descr = "test suite"
summary xs = show (length xs) ++ " test cases"
parseSemInput :: Text -> Either ParseError SemInput
parseSemInput =
fmap smooth . runParser geniSemanticInput () "semantics"
where
smooth (s,r,l) = (sortSem s, sort r, l)
withFlag :: forall f a . (Eq f, Typeable f)
=> (FilePath -> f)
-> ProgState
-> IO a
-> (FilePath -> IO a)
-> IO a
withFlag flag pst z job =
maybe z job $ getFlag flag (pa pst)
withFlagOrIgnore :: forall f . (Eq f, Typeable f)
=> (FilePath -> f)
-> ProgState
-> (FilePath -> IO ())
-> IO ()
withFlagOrIgnore flag pst = withFlag flag pst (return ())
withFlagOrDie :: forall f a . (Eq f, Typeable f)
=> (FilePath -> f)
-> ProgState
-> String
-> (FilePath -> IO a)
-> IO a
withFlagOrDie flag pst description =
withFlag flag pst (fail msg)
where
msg = "Please specify a " ++ description ++ " file!"
withLoadStatus :: Bool
-> FilePath
-> String
-> (a -> String)
-> (FilePath -> IO (Either Text a))
-> IO (Either Text a)
withLoadStatus False f _ _ p = p f
withLoadStatus True f d summarise p = do
ePutStr $ unwords [ "Loading", d, f ++ "... " ]
eFlush
mx <- p f
ePutStrLn $ either (const "ERROR") (\x -> summarise x ++ " loaded") mx
return mx
parseFromFileMaybeBinary :: Binary a
=> (FilePath -> IO (Either Text a))
-> FilePath
-> IO (Either Text a)
parseFromFileMaybeBinary p f =
if takeExtension f == ".genib"
then Right <$> decodeFile f
else p f
data GeniResults = GeniResults
{ grResults :: [GeniResult]
, grGlobalWarnings :: [Text]
, grStatistics :: Statistics
}
data GeniResult = GError GeniError
| GSuccess GeniSuccess
deriving (Ord, Eq)
isSuccess :: GeniResult -> Bool
isSuccess (GSuccess _) = True
isSuccess (GError _) = False
data GeniError = GeniError [Text]
deriving (Ord, Eq)
data GeniSuccess = GeniSuccess
{ grLemmaSentence :: LemmaPlusSentence
, grRealisations :: [Text]
, grResultType :: ResultType
, grWarnings :: [Text]
, grDerivation :: B.TagDerivation
, grOrigin :: Integer
, grLexSelection :: [GeniLexSel]
, grRanking :: Int
, grViolations :: [OtViolation]
} deriving (Ord, Eq)
data GeniLexSel = GeniLexSel
{ nlTree :: Text
, nlTrace :: [Text]
} deriving (Ord, Eq)
data ResultType = CompleteResult | PartialResult deriving (Ord, Eq)
instance Pretty GeniError where
pretty (GeniError xs) = T.intercalate "\n" $ map ("Error:" <+>) xs
runGeni :: ProgState
-> CustomSem sem
-> B.Builder st it
-> TestCase sem
-> ErrorIO (GeniResults,st)
runGeni pst selector builder tc = do
istuff <- initGeni pst selector semInput
liftIO $ runBuilder istuff
where
iflags = flags $ case tcParams tc of
Nothing -> pa pst
Just new -> updateParams new (pa pst)
semInput = tcSem tc
runBuilder (initStuff, initWarns) = do
let run = B.run builder
start <- rnf initStuff `seq` getCPUTime
let (finalSt, stats) = run initStuff iflags
results <- extractResults pst (tcParams tc) builder finalSt
end <- rnf results `seq` getCPUTime
let elapsedTime = picosToMillis $! end start
diff = round (elapsedTime :: Double) :: Int
stats2 = updateMetrics (incrIntMetric "gen_time" (fromIntegral diff) ) stats
gresults = GeniResults { grResults = results
, grStatistics = stats2
, grGlobalWarnings = map showWarnings (fromGeniWarnings initWarns)
}
return (gresults, finalSt)
showWarnings = T.intercalate "\n" . showGeniWarning
simplifyResults :: Either Text (GeniResults, st) -> GeniResults
simplifyResults (Left t) = GeniResults
{ grResults = [GError $ GeniError [t]]
, grGlobalWarnings = []
, grStatistics = emptyStats
}
simplifyResults (Right (r,_)) = r
extractResults :: ProgState
-> Maybe Params
-> B.Builder st it
-> st
-> IO [GeniResult]
extractResults pst newPa builder finalSt = do
let uninflected = B.unpack builder finalSt
(rawResults, resultTy) =
if null uninflected && hasFlag PartialFlg pst
then (B.partial builder finalSt, PartialResult)
else (uninflected , CompleteResult)
status = B.finished builder finalSt
debugM logname $ "tree assembly status: " ++ prettyStr status
finaliseResults pst newPa (resultTy, status, rawResults)
initGeni :: ProgState
-> CustomSem sem
-> sem
-> ErrorIO (B.Input, GeniWarnings)
initGeni pst wrangler csem = do
selection <- runLexSelection pst wrangler csem
liftIO $ debugM logname $
"lexical selection returned " ++
(show . length $ lsAnchored selection) ++
" anchored trees"
semInput <- liftEither $ fromCustomSemInput wrangler csem
let initStuff = B.Input
{ B.inSemInput = semInput
, B.inLex = lsLexEntries selection
, B.inCands = map (\c -> (c, emptyPolPaths)) (lsAnchored selection)
}
return (initStuff, lsWarnings selection)
finaliseResults :: ProgState
-> Maybe Params
-> (ResultType, B.GenStatus, [B.Output])
-> IO [GeniResult]
finaliseResults pst newPa (ty, status, os) = do
debugM logname $ "finalising " ++ show (length sentences) ++ " results"
mss <- case (getFlag MorphCmdFlg pst, customMorph pst) of
(Just cmd, _) -> map snd <$> inflectSentencesUsingCmd cmd sentences
(_, Just morph) -> return $ morph (morphFlags config) sentences
(Nothing, Nothing) -> return $ map sansMorph sentences
let unranked = zipWith sansRanking os mss
rank = rankResults (getTraces pst) grDerivation (getRanking config)
successes = map addRanking (rank unranked)
failures = case status of
B.Error str -> [GeniError [str]]
B.Finished -> []
B.Active -> []
return (map GError failures ++ map GSuccess successes)
where
config = case newPa of
Nothing -> pa pst
Just pa2 -> updateParams pa2 (pa pst)
sentences = map snd3 os
sansRanking (i,l,d) rs = GeniSuccess
{ grLemmaSentence = l
, grRealisations = moRealisations rs
, grWarnings = moWarnings rs
, grDerivation = d
, grLexSelection = map (\x -> GeniLexSel x (getTraces pst x)) (B.lexicalSelection d)
, grRanking = 1
, grViolations = []
, grResultType = ty
, grOrigin = i
}
addRanking (i,res,vs) = res { grViolations = vs, grRanking = i }
showRealisations :: [String] -> String
showRealisations [] = "(none)"
showRealisations xs = unlines . map sho . Map.toList . histogram $ xs
where
sho (x,1) = x
sho (x,c) = x ++ " (" ++ show c ++ " instances)"
lemmaSentenceString :: GeniSuccess -> Text
lemmaSentenceString = T.unwords . map lpLemma . grLemmaSentence
prettyResult :: ProgState -> GeniSuccess -> Text
prettyResult pst nr =
T.intercalate "\n" . map showOne . grRealisations $ nr
where
showOne str = pretty theRanking <> ". " <> str <> "\n" <> violations
violations = prettyViolations tracesFn verbose (grViolations nr)
theRanking = grRanking nr
verbose = hasFlag VerboseModeFlg pst
tracesFn = getTraces pst
getTraces :: ProgState -> Text -> [Text]
getTraces pst tname =
filt $ concat [ ptrace t | t <- gr pst, pidname t == readPidname tname ]
where
filt = case traces pst of
[] -> id
theTs -> filter (`elem` theTs)
readPidname :: Text -> Text
readPidname n =
case T.splitOn ":" n of
(_:_:p:_) -> p
_ -> geniBug "NLP.GenI.readPidname or combineName are broken"
runLexSelection :: ProgState
-> CustomSem sem
-> sem
-> ErrorIO LexicalSelection
runLexSelection pst wrangler csem = do
let verbose = hasFlag VerboseModeFlg pst
selector = customSelector wrangler
selection <- liftIO $ selector (gr pst) (le pst) csem
sem@(tsem, _, _) <- liftEither $ fromCustomSemInput wrangler csem
let lexCand = lsLexEntries selection
candFinal = finaliseLexSelection (morphinf pst) sem (lsAnchored selection)
when verbose $ liftIO $ T.hPutStrLn stderr . T.unlines $
"Lexical items selected:"
: map (indent . showLexeme . fromFL . iword) lexCand
++ ["Trees anchored (family) :"]
++ map (indent . idname) candFinal
let semWarnings = case missingLiterals candFinal tsem of
[] -> []
xs -> [NoLexSelection xs]
return $ selection { lsAnchored = candFinal
, lsWarnings = mkGeniWarnings semWarnings <> lsWarnings selection
}
where
indent x = ' ' `T.cons` x
defaultCustomSem :: ProgState -> IO (CustomSem SemInput)
defaultCustomSem pst = mkDefaultCustomSem pst <$>
case grammarType of
PreAnchored -> mkPreAnchoredLexicalSelector pst
_ -> return defaultLexicalSelector
where
grammarType = getGrammarType $ geniFlags . pa $ pst
mkDefaultCustomSem :: ProgState
-> LexicalSelector SemInput
-> CustomSem SemInput
mkDefaultCustomSem pst selector = CustomSem
{ fromCustomSemInput = Right
, customSelector = \t l s -> selector t l (tweakSem s)
, customRenderSem = geniShowText
, customSemParser = \t ->
trivialTestCase t <$> (fromParsec . parseSemInput) t
, customSuiteParser = \f -> fmap fromTestSuiteL . lParse f
}
where
trivialTestCase t s = TestCase
{ tcName = "(sem)"
, tcSemString = t
, tcSem = s
, tcExpected = []
, tcParams = Nothing
}
tweakSem = stripMorphStuff . maybeRemoveConstraints
stripMorphStuff = first3 (stripMorphSem (morphinf pst))
maybeRemoveConstraints =
if hasOpt NoConstraints (geniFlags (pa pst)) then removeConstraints else id
missingLiterals :: [TagElem] -> [Literal GeniVal] -> [Literal GeniVal]
missingLiterals cands tsem =
tsem \\ (nub $ concatMap tsemantics cands)
finaliseLexSelection :: MorphInputFn -> SemInput -> [TagElem] -> [TagElem]
finaliseLexSelection morph (tsem,_,_) =
setTidnums . considerCoherency . considerMorph
where
considerMorph = attachMorph morph tsem
considerCoherency = filter (all (`elem` tsem) . tsemantics)
newtype PreAnchoredL = PreAnchoredL [TagElem]
instance Loadable PreAnchoredL where
lParse f = fmap PreAnchoredL
. fromParsec
. runParser geniTagElems () f
lSet _ p = p
lSummarise (PreAnchoredL xs) = show (length xs) ++ " trees"
readPreAnchored :: ProgState -> IO [TagElem]
readPreAnchored pst = withFlagOrDie flg pst descr $ \f -> do
x <- withLoadStatus v f descr lSummarise lParseFromFile
>>= throwOnParseError descr
let PreAnchoredL xs = x
return xs
where
v = hasFlag VerboseModeFlg pst
flg = MacrosFlg
descr = "preanchored trees"
mkPreAnchoredLexicalSelector :: ProgState -> IO (LexicalSelector SemInput)
mkPreAnchoredLexicalSelector pst = do
xs <- readPreAnchored pst
return (\_ _ _ -> return (LexicalSelection xs [] mempty))
readFileUtf8 :: FilePath -> IO Text
readFileUtf8 f = T.decodeUtf8 <$> BS.readFile f
verbosity :: ProgStateRef -> IO Bool
verbosity = fmap (hasFlag VerboseModeFlg)
. readIORef
instance JSON GeniResults where
readJSON j = do
jo <- fromJSObject `fmap` readJSON j
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
GeniResults <$> field "results"
<*> field "warnings"
<*> field "statistics"
showJSON x = JSObject . toJSObject $
[ ("results", showJSONs $ grResults x)
, ("warnings", showJSONs $ grGlobalWarnings x)
, ("statistics", showJSON $ grStatistics x)
]
instance JSON GeniResult where
readJSON j =
case readJSON j of
Ok s -> Ok (GSuccess s)
Error _ -> GError `fmap` readJSON j
showJSON (GSuccess x) = showJSON x
showJSON (GError x) = showJSON x
instance JSON GeniSuccess where
readJSON j = do
jo <- fromJSObject `fmap` readJSON j
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
GeniSuccess <$> field "raw"
<*> field "realisations"
<*> field "result-type"
<*> field "warnings"
<*> field "derivation"
<*> field "chart-item"
<*> field "lexical-selection"
<*> field "ranking"
<*> field "violations"
showJSON nr = JSObject . toJSObject $
[ ("raw" , showJSON $ grLemmaSentence nr)
, ("realisations" , showJSONs $ grRealisations nr)
, ("derivation" , showJSONs $ grDerivation nr)
, ("lexical-selection", showJSONs $ grLexSelection nr)
, ("ranking" , showJSON $ grRanking nr)
, ("violations" , showJSONs $ grViolations nr)
, ("result-type" , showJSON $ grResultType nr)
, ("chart-item" , showJSON $ grOrigin nr)
, ("warnings" , showJSONs $ grWarnings nr)
]
instance JSON GeniError where
readJSON j = do
jo <- fromJSObject <$> readJSON j
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
GeniError <$> field "errors"
showJSON (GeniError xs) =
JSObject . toJSObject $ [ ("errors", showJSON xs) ]
instance JSON ResultType where
readJSON j = do
js <- fromJSString `fmap` readJSON j
case js of
"partial" -> return PartialResult
"complete" -> return CompleteResult
ty -> fail $ "unknown result type: " ++ ty
showJSON CompleteResult = JSString $ toJSString "complete"
showJSON PartialResult = JSString $ toJSString "partial"
instance JSON GeniLexSel where
readJSON j = do
jo <- fromJSObject `fmap` readJSON j
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
GeniLexSel <$> field "lex-item"
<*> field "trace"
showJSON x = JSObject . toJSObject $
[ ("lex-item", showJSON $ nlTree x)
, ("trace", showJSONs $ nlTrace x)
]
picosToMillis :: Integer -> Double
picosToMillis t = realToFrac t / (10^(9 :: Int))
data MNAME = MNAME deriving Typeable
logname :: String
logname = mkLogname MNAME
instance NFData GeniResult where
rnf (GError x1) = rnf x1 `seq` ()
rnf (GSuccess x1) = rnf x1 `seq` ()
instance NFData GeniSuccess where
rnf (GeniSuccess x1 x2 x3 x4 x5 x6 x7 x8 x9)
= rnf x1 `seq`
rnf x2 `seq`
rnf x3 `seq`
rnf x4 `seq`
rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` ()
instance NFData GeniError where
rnf (GeniError x1) = rnf x1 `seq` ()
instance NFData ResultType where
rnf CompleteResult = ()
rnf PartialResult = ()
instance NFData GeniLexSel where
rnf (GeniLexSel x1 x2) = rnf x1 `seq` rnf x2 `seq` ()