From a64131afbec2ced7919dee28326beda827a38bee Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Thu, 7 Sep 2006 14:21:08 +0000
Subject: RunGHCC for testing

---
 src/GF/Canon/GFCC/RunGFCC.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 src/GF/Canon/GFCC/RunGFCC.hs

(limited to 'src/GF/Canon/GFCC/RunGFCC.hs')

diff --git a/src/GF/Canon/GFCC/RunGFCC.hs b/src/GF/Canon/GFCC/RunGFCC.hs
new file mode 100644
index 000000000..be2ed3358
--- /dev/null
+++ b/src/GF/Canon/GFCC/RunGFCC.hs
@@ -0,0 +1,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
+-}
-- 
cgit v1.2.3