blob: be2ed3358dbe37ba9cc048248c3464ab854f6662 (
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
|
module Main where
import GF.Canon.GFCC.DataGFCC
import GF.Canon.GFCC.AbsGFCC
import GF.Canon.GFCC.ParGFCC
import GF.Canon.GFCC.PrintGFCC
import GF.Data.Operations
import Data.Map
import System
-- Simple translation application built on GFCC. AR 7/9/2006
main :: IO ()
main = do
file <- getLine ----getArgs
grammar <- file2gfcc file
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 = do
let t = readExp s
putStrLn $ printTree $ linExp grammar lang t
putStrLn $ linearize grammar lang t
where
lang = head $ 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 (error "no parse") id . (pExp . myLexer)
{-
treat grammar s = putStrLn $ case comm of
["lin"] -> unlines $ linearizeAll grammar $ readTree grammar rest
["lin",lang] -> linearize grammar lang $ readTree grammar rest
["parse",cat] -> unlines $ map showTree $ concat $ parseAll grammar cat rest
["parse",lang,cat] -> unlines $ map showTree $ parse grammar lang cat rest
["langs"] -> unwords $ languages grammar
["cats"] -> unwords $ categories grammar
["help"] -> helpMsg
_ -> "command not interpreted: " ++ s
where
(comm,rest) = (words c,drop 1 r) where
(c,r) = span (/=':') s
-}
|
