blob: 7cf611d4042599a1d24e1eff800b9e0ddbe54164 (
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
|
module Main where
import GF.Canon.GFCC.GenGFCC
import GF.Canon.GFCC.DataGFCC
import GF.Canon.GFCC.AbsGFCC
import GF.Canon.GFCC.ParGFCC
import GF.Canon.GFCC.PrintGFCC
import GF.Canon.GFCC.ErrM
--import GF.Data.Operations
import Data.Map
import System.Random (newStdGen)
import System
-- Simple translation application built on GFCC. AR 7/9/2006
main :: IO ()
main = do
file:_ <- getArgs
grammar <- file2gfcc file
putStrLn $ statGFCC grammar
loop grammar
loop :: GFCC -> IO ()
loop grammar = do
s <- getLine
if s == "quit" then return () else do
treat grammar s
loop grammar
treat :: GFCC -> String -> IO ()
treat grammar s = case words s of
"gt":cat:n:_ -> do
mapM_ prlinonly $ take (read n) $ generate grammar (CId cat)
"gtt":cat:n:_ -> do
mapM_ prlin $ take (read n) $ generate grammar (CId cat)
"gr":cat:n:_ -> do
gen <- newStdGen
mapM_ prlinonly $ take (read n) $ generateRandom gen grammar (CId cat)
"grt":cat:n:_ -> do
gen <- newStdGen
mapM_ prlin $ take (read n) $ generateRandom gen grammar (CId cat)
"p":cat:n:ws -> do
case parse (read n) grammar (CId cat) ws of
t:_ -> prlin t
_ -> putStrLn "no parse found"
_ -> lins $ readExp s
where
lins t = mapM_ (lint t) $ cncnames grammar
lint t lang = do
putStrLn $ printTree $ linExp grammar lang t
lin t lang
lin t lang = do
putStrLn $ linearize grammar lang t
prlins t = do
putStrLn $ printTree t
lins t
prlin t = do
putStrLn $ printTree t
prlinonly t
prlinonly t = mapM_ (lin t) $ cncnames grammar
--- should be in an API
file2gfcc :: FilePath -> IO GFCC
file2gfcc f =
readFile f >>= err (error "no parse") (return . mkGFCC) . pGrammar . myLexer
readExp :: String -> Exp
readExp = err (const exp0) id . (pExp . myLexer)
err f g ex = case ex of
Ok x -> g x
Bad s -> f s
|
