forked from GitHub/gf-core
76 lines
1.8 KiB
Haskell
76 lines
1.8 KiB
Haskell
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
|
|
|