blob: cf90ae2a4547ee2817cab31ebe162ec1388d9133 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
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
|
