From ef389db5694a52eb9c171fe76b952f37216e4c09 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Wed, 19 Sep 2007 16:48:13 +0000
Subject: started extending GFCC API with parsing

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

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

diff --git a/src/GF/Canon/GFCC/Shell.hs b/src/GF/Canon/GFCC/Shell.hs
new file mode 100644
index 000000000..bc33e7949
--- /dev/null
+++ b/src/GF/Canon/GFCC/Shell.hs
@@ -0,0 +1,62 @@
+module Main where
+
+import GF.Canon.GFCC.GFCCAPI
+import qualified GF.Canon.GFCC.GenGFCC as G ---
+import GF.Canon.GFCC.AbsGFCC (CId(CId)) ---
+import System.Random (newStdGen)
+import System (getArgs)
+
+
+-- Simple translation application built on GFCC. AR 7/9/2006 -- 19/9/2007
+
+main :: IO ()
+main = do
+  file:_  <- getArgs
+  grammar <- file2grammar file
+  putStrLn $ "languages:  " ++ unwords (languages grammar)
+  putStrLn $ "categories: " ++ unwords (categories grammar)
+  loop grammar
+
+loop :: MultiGrammar -> IO ()
+loop grammar = do
+  s <- getLine
+  if s == "quit" then return () else do
+    treat grammar s
+    loop grammar
+
+treat :: MultiGrammar -> String -> IO ()
+treat grammar s = case words s of
+  "gt":cat:n:_ -> do
+    mapM_ prlinonly $ take (read n) $ G.generate grammar (CId cat)
+  "gtt":cat:n:_ -> do
+    mapM_ prlin $ take (read n) $ G.generate grammar (CId cat)
+  "gr":cat:n:_ -> do
+    gen <- newStdGen
+    mapM_ prlinonly $ take (read n) $ G.generateRandom gen grammar (CId cat)
+  "grt":cat:n:_ -> do
+    gen <- newStdGen
+    mapM_ prlin $ take (read n) $ G.generateRandom gen grammar (CId cat)
+  "p":lang:cat:ws -> do
+    let ts = parse grammar lang cat $ unwords ws
+    mapM_ (putStrLn . showTree) ts 
+  "search":cat:n:ws -> do
+    case G.parse (read n) grammar (CId cat) ws of
+      t:_ -> prlin t
+      _ -> putStrLn "no parse found" 
+  _ -> lins $ readTree grammar s
+ where
+  langs = languages grammar
+  lins t = mapM_ (lint t) $ langs 
+  lint t lang = do
+----    putStrLn $ showTree $ linExp grammar lang t 
+    lin t lang
+  lin t lang = do
+    putStrLn $ linearize grammar lang t
+  prlins t = do
+    putStrLn $ showTree t
+    lins t
+  prlin t = do
+    putStrLn $ showTree t
+    prlinonly t
+  prlinonly t = mapM_ (lin t) $ langs
+
-- 
cgit v1.2.3