lojysamban (empty) → 0.0.1

raw patch · 4 files changed

+218/−0 lines, 4 filesdep +basedep +lojbanParsersetup-changed

Dependencies added: base, lojbanParser

Files

• LICENSE +27/−0
• Setup.hs +2/−0
• lojsamban.hs +166/−0
• lojysamban.cabal +23/−0

@@ -0,0 +1,27 @@+Copyright (c) 2011, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.++  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.++  * Neither the name of the Yoshikuni Jujo nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,166 @@+import PrologLike+import Language.Lojban.Parser hiding (LA, Brivla, KOhA, GOhA, NA, LerfuString)+import qualified Language.Lojban.Parser as P+import System.Environment+import Data.Maybe+import Data.Either+import Data.List++main :: IO ()+main = do+	[fn] <- getArgs+	src <- readFile fn+	let Right p = parse src+	let facts = map readSentence $ getSentences p+--	print facts+	q <- (readSentence . either (error "bad") id . parse) `fmap` getLine+	putStrLn $ case ask q facts of+		Just r -> case answerMa r of+			Just ma -> ma+			Nothing -> case answerRelfuString r of+				Just rs -> rs+				Nothing -> "go'i"+		Nothing -> "nago'i"+--	maybe (return ()) putStrLn $ answerRelfuString $ ask q facts+--	putStrLn $ if ask q facts then "go'i" else "nago'i"+--	putStrLn $ show $ ask q facts+--	print q++answerRelfuString :: [[(Term, Term)]] -> Maybe String+answerRelfuString ps+	| null answers = Nothing+	| otherwise = Just $ intercalate " .ija " answers+	where+	answers = map answerRelfuString1 ps++answerRelfuString1 :: [(Term, Term)] -> String+answerRelfuString1 ps = "tu'e " ++ intercalate " .ije " (map showDU rsps) ++ " tu'u"+	where+	rsps = filter isRSPair ps++showDU :: (Term, Term) -> String+showDU (LerfuString ls, LA n) = ls ++ " du la " ++ n+showDU (LerfuString ls, LO n) = ls ++ " du lo " ++ n++isRSPair :: (Term, Term) -> Bool+isRSPair (LerfuString _, _) = True+isRSPair _ = False++answerMa :: [[(Term, Term)]] -> Maybe String+answerMa ps+	| null answers = Nothing+	| otherwise = Just $ intercalate " .a " answers+	where+	answers = catMaybes $ map answerMa1 ps++answerMa1 :: [(Term, Term)] -> Maybe String+answerMa1 ps = case lookup (VKOhA "ma") ps of+	Nothing -> Nothing+	Just (LA n) -> Just $ "la " ++ n+	Just (LO n) -> Just $ "lo " ++ n++getSentences :: Sentence -> [Sentence]+getSentences (IText_1 _ _ _ _ (Just t)) = getSentences t+getSentences (StatementI s1 ss) = s1 : catMaybes (map (\(_, _, s) -> s) ss)+getSentences o = error $ show o++headTerms :: Sentence -> [Sumti]+headTerms (TermsBridiTail ts _ _ _) = ts+headTerms _ = []++bridiTail :: Sentence -> Sentence+bridiTail (TermsBridiTail _ _ _ bt) = bt+bridiTail o = o++selbri :: Sentence -> Selbri+selbri (SelbriTailTerms s _ _ _) = s+selbri _ = P.Brivla ([], "", []) []++tailTerms :: Sentence -> [Sumti]+tailTerms (SelbriTailTerms _ ts _ _) = ts+tailTerms _ = []++function :: Selbri -> Function+function (P.Brivla (_, n, _) _) = Brivla n+function (P.GOhA (_, n, _) _ _) = GOhA n+function (P.NA (_, "na", _) _ s) = NA $ function s++readLALO :: Sumti -> Term+readLALO (P.LA (_, "la", _) _ _ ns _) = LA $ concat $ map ((++ ".") . snd3) ns+readLALO (P.LALE (_, "lo", _) _ st _ _) = LO $ readSumtiTail st+readLALO (P.KOhA (_, k@"ma", _) _) = VKOhA k+readLALO (P.KOhA (_, k@"da", _) _) = VKOhA k+readLALO (P.KOhA (_, k@"de", _) _) = VKOhA k+readLALO (P.KOhA (_, k@"di", _) _) = VKOhA k+readLALO (P.KOhA (_, k@"do", _) _) = VKOhA k+readLALO (P.KOhA (_, k, _) _) = KOhA k+readLALO (P.LerfuString s _ _) = LerfuString $ concatMap snd3 s++readSumtiTail :: SumtiTail -> String+readSumtiTail (SelbriRelativeClauses (P.Brivla (_, n, _) _) _) = n+readSumtiTail st = show st++readSentence :: Sentence -> FactRule+readSentence s@(TermsBridiTail _ _ _ _) = Fact f $ h ++ t+	where+	h = map readLALO $ headTerms s+	f = function $ selbri $ bridiTail s+	t = map readLALO $ tailTerms $ bridiTail s+readSentence (IJoikJek s [r]) = Rule (readSentence s) (getRule r)++getRule (_, Jek _ _ (_, "ja", _) (Just (_, "nai", _)), _, Just t) = readTUhE t++readTUhE (TUhE _ _ _ t _ _) = map readSentence $ getSentences t++checkKOhA :: FactRule -> FactRule -> [(Term, Term)]+checkKOhA (Fact _ ts1) (Fact _ ts2) = zip ts1 ts2++{-+findFacts :: FactRule -> [FactRule] -> [FactRule]+findFacts (Fact f0 _) fs = filter (isFactFor f0) fs++isFactFor :: Function -> FactRule -> Bool+isFactFor f0 (Fact f1 _) = f0 == f1+isFactFor _ _ = False++ask :: FactRule -> [FactRule] -> Bool+ask (Fact (NA f) ts) facts = not $ ask (Fact f ts) facts+ask (Fact (GOhA "du") ts) _ = ts !! 0 == ts !! 1+ask q@(Fact f ts) facts+	| q `elem` facts = True+	| otherwise = case findRule q facts of+		Nothing -> False+		Just r -> and $ map (flip ask facts) $ apply ts r++findRule :: FactRule -> [FactRule] -> Maybe FactRule+findRule (Fact f _) rs = let ret = filter (isRuleFor f) rs in+	if null ret then Nothing else Just $ head ret++isRuleFor :: Function -> FactRule -> Bool+isRuleFor f0 (Rule (Fact f1 _) _) = f0 == f1+isRuleFor _ _ = False++apply :: [Term] -> FactRule -> [FactRule]+apply ts2 (Rule (Fact _ ts1) fs) = map (changeFactTerms ts1 ts2) fs++changeFactTerms :: [Term] -> [Term] -> FactRule -> FactRule+changeFactTerms ts1 ts2 (Fact f ts) = Fact f $ changeTerms ts1 ts2 ts++changeTerms :: [Term] -> [Term] -> [Term] -> [Term]+changeTerms [] _ ts = ts+changeTerms _ [] ts = ts+changeTerms (t1 : ts1) (t2 : ts2) ts =+	changeTerms ts1 ts2 $ changeTerm t1 t2 ts++changeTerm :: Term -> Term -> [Term] -> [Term]+changeTerm _ _ [] = []+changeTerm t1 t2 (t : ts)+	| t == t1 = t2 : changeTerm t1 t2 ts+	| otherwise = t : changeTerm t1 t2 ts++sampleRule = Rule (Fact (Brivla "pendo") [KOhA "da", KOhA "de"])+	[Fact (Brivla "nelci") [KOhA "da", KOhA "de"]]+-}++snd3 :: (a, b, c) -> b+snd3 (_, y, _) = y

@@ -0,0 +1,23 @@+build-type:		Simple+cabal-version:		>= 1.6++name:			lojysamban+version:		0.0.1+stability:		experimental+author:			.iocikun.juj. <PAF01143@nifty.ne.jp>+maintainer:		.iocikun.juj. <PAF01143@nifty.ne.jp>++license:		BSD3+license-file:		LICENSE++category:		Language+synopsis:		Prolog with lojban+description:		Prolog with lojban++source-repository	head+    type:		git+    location:		git://github.com/YoshikuniJujo/lojsamban.git++executable		lojysamban+    main-is:		lojsamban.hs+    build-depends:	base > 3 && < 5, lojbanParser