forked from GitHub/gf-core
Embed/TemplateApp
This commit is contained in:
@@ -15,13 +15,15 @@
|
||||
|
||||
module GF.Embed.EmbedAPI where
|
||||
|
||||
import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar)
|
||||
import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar,firstStateGrammar,allLanguages,allCategories)
|
||||
import GF.UseGrammar.Linear (linTree2string)
|
||||
import GF.UseGrammar.GetTree (string2tree)
|
||||
import GF.Embed.EmbedParsing (parseString)
|
||||
import GF.Canon.CMacros (noMark)
|
||||
import GF.Grammar.Grammar (Trm)
|
||||
import GF.Grammar.MMacros (exp2tree)
|
||||
import GF.Grammar.Macros (zIdent)
|
||||
import GF.Grammar.PrGrammar (prt_)
|
||||
import GF.Grammar.Values (tree2exp)
|
||||
import GF.Grammar.TypeCheck (annotate)
|
||||
import GF.Canon.GetGFC (getCanonGrammar)
|
||||
@@ -47,9 +49,19 @@ type Category = String
|
||||
type Tree = Trm
|
||||
|
||||
file2grammar :: FilePath -> IO MultiGrammar
|
||||
|
||||
linearize :: MultiGrammar -> Language -> Tree -> String
|
||||
parse :: MultiGrammar -> Language -> Category -> String -> [Tree]
|
||||
|
||||
linearizeAll :: MultiGrammar -> Tree -> [String]
|
||||
parseAll :: MultiGrammar -> Category -> String -> [[Tree]]
|
||||
|
||||
readTree :: MultiGrammar -> String -> Tree
|
||||
showTree :: Tree -> String
|
||||
|
||||
languages :: MultiGrammar -> [Language]
|
||||
categories :: MultiGrammar -> [Category]
|
||||
|
||||
---------------------------------------------------
|
||||
-- Implementation
|
||||
---------------------------------------------------
|
||||
@@ -76,3 +88,15 @@ parse mgr lang cat =
|
||||
sgr = stateGrammarOfLang mgr (zIdent lang)
|
||||
cfcat = string2CFCat abs cat
|
||||
abs = maybe (error "no abstract syntax") prIdent $ abstract mgr
|
||||
|
||||
linearizeAll mgr t = [linearize mgr lang t | lang <- languages mgr]
|
||||
|
||||
parseAll mgr cat s = [parse mgr lang cat s | lang <- languages mgr]
|
||||
|
||||
readTree mgr s = tree2exp $ string2tree (firstStateGrammar mgr) s
|
||||
|
||||
showTree t = prt_ t
|
||||
|
||||
languages mgr = [prt_ l | l <- allLanguages mgr]
|
||||
|
||||
categories mgr = [prt_ c | (_,c) <- allCategories mgr]
|
||||
|
||||
44
src/GF/Embed/TemplateApp.hs
Normal file
44
src/GF/Embed/TemplateApp.hs
Normal file
@@ -0,0 +1,44 @@
|
||||
module Main where
|
||||
|
||||
import GF.Embed.EmbedAPI
|
||||
import System
|
||||
|
||||
-- Simple translation application built on EmbedAPI. AR 7/10/2005
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
file:_ <- getArgs
|
||||
grammar <- file2grammar file
|
||||
translate grammar
|
||||
|
||||
translate :: MultiGrammar -> IO ()
|
||||
translate grammar = do
|
||||
s <- getLine
|
||||
if s == "quit" then return () else do
|
||||
treat grammar s
|
||||
translate grammar
|
||||
|
||||
treat :: MultiGrammar -> String -> IO ()
|
||||
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
|
||||
|
||||
helpMsg = unlines [
|
||||
"lin : <Tree>",
|
||||
"lin <Lang> : <Tree>",
|
||||
"parse <Cat> : <String>",
|
||||
"parse <Lang> <Cat> : <String>",
|
||||
"langs",
|
||||
"cats",
|
||||
"help",
|
||||
"quit"
|
||||
]
|
||||
@@ -26,6 +26,8 @@ MSI_FILE=gf-$(subst .,_,$(PACKAGE_VERSION)).msi
|
||||
|
||||
GF_DATA_DIR=$(datadir)/GF-$(PACKAGE_VERSION)
|
||||
|
||||
EMBED = GF/Embed/TemplateApp
|
||||
|
||||
# use the temporary binary file name 'gf-bin' to not clash with directory 'GF'
|
||||
# on case insensitive file systems (such as FAT)
|
||||
GF_EXE=gf$(EXEEXT)
|
||||
@@ -73,6 +75,11 @@ build:
|
||||
opt: GHCFLAGS += $(GHCOPTFLAGS)
|
||||
opt: build
|
||||
|
||||
embed: GHCFLAGS += $(GHCOPTFLAGS)
|
||||
embed:
|
||||
$(GHMAKE) $(GHCFLAGS) $(EMBED) -o $(EMBED)
|
||||
strip $(EMBED)
|
||||
|
||||
noopt: build
|
||||
|
||||
ghci: ghci-nofud
|
||||
|
||||
Reference in New Issue
Block a user