forked from GitHub/gf-core
86 lines
1.9 KiB
Haskell
86 lines
1.9 KiB
Haskell
module Main where
|
|
|
|
import GSyntax
|
|
import GF.Embed.EmbedAPI
|
|
|
|
import GF.Infra.UseIO
|
|
|
|
-- to compile: make
|
|
|
|
main :: IO ()
|
|
main = do
|
|
gr <- file2grammar "database.gfcm"
|
|
loop gr
|
|
|
|
loop :: MultiGrammar -> IO ()
|
|
loop gr = do
|
|
putStrFlush "> "
|
|
s <- getLine
|
|
let ts = parse gr "DatabaseEng" "Query" s
|
|
case ts of
|
|
[t] -> case fg t of
|
|
GQuit -> putStrLnFlush (linearize gr "DatabaseEng" (gf GBye)) >> return ()
|
|
t' -> case reply t' of
|
|
Left r -> (putStrLnFlush $ linearize gr "DatabaseEng" $ gf r) >> loop gr
|
|
Right xs -> print xs >> loop gr
|
|
[] -> putStrLnFlush "no parse" >> loop gr
|
|
_ -> do
|
|
putStrLnFlush "ambiguous parse:"
|
|
---- mapM_ (putStrLn . prGFTree) ts
|
|
loop gr
|
|
|
|
-- the question-answer relation
|
|
|
|
reply :: GQuery -> Either GAnswer [Ent]
|
|
reply (GQueryS s) = Left $ if (iS s) then GYes else GNo
|
|
reply (GQueryQ q) = case iQ q of
|
|
[] -> Left GNone
|
|
xs -> Right xs
|
|
{- much less efficient:
|
|
xs -> GList $ list xs
|
|
where
|
|
list [x] = GOne (GInt (show x))
|
|
list (x:xs) = GCons (GInt (show x)) (list xs)
|
|
-}
|
|
|
|
-- denotational semantics
|
|
|
|
type Ent = Integer
|
|
type Prop = Bool
|
|
|
|
domain :: [Ent]
|
|
domain = [0..10000] ---
|
|
|
|
primes = sieve (drop 2 domain) where
|
|
sieve (p:x) = p : sieve [ n | n <- x, n `mod` p > 0 ]
|
|
sieve [] = []
|
|
|
|
iS :: GS -> Prop
|
|
iS (GPredA1 np ap) = iNP np (iA1 ap)
|
|
|
|
iQ :: GQ -> [Ent]
|
|
iQ (GWhichA1 cn a) = [e | e <- iCN cn, iA1 a e]
|
|
iQ (GWhichA2 cn np a) = [e | e <- iCN cn, iNP np (\x -> iA2 a x e)]
|
|
|
|
iA1 :: GA1 -> Ent -> Prop
|
|
iA1 (GComplA2 f q) = iNP q . iA2 f
|
|
iA1 GEven = even
|
|
iA1 GOdd = odd
|
|
iA1 GPrime = flip elem primes
|
|
|
|
iA2 :: GA2 -> Ent -> Ent -> Prop
|
|
iA2 GEqual = (==)
|
|
iA2 GGreater = (>)
|
|
iA2 GSmaller = (<)
|
|
iA2 GDivisible = \x y -> y /= 0 && mod x y == 0
|
|
|
|
|
|
iCN :: GCN -> [Ent]
|
|
iCN GNumber = domain
|
|
|
|
iNP :: GNP -> (Ent -> Prop) -> Prop
|
|
iNP (GEvery cn) p = all p (iCN cn)
|
|
iNP (GSome cn) p = any p (iCN cn)
|
|
iNP (GUseInt (GInt n)) p = p n
|
|
|