diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs index 1262505a1..290b6ba33 100644 --- a/src/GF/Canon/CanonToGFCC.hs +++ b/src/GF/Canon/CanonToGFCC.hs @@ -70,7 +70,7 @@ normalize = share . unoptimizeCanon . Sub.unSubelimCanon where canon2gfcc :: CanonGrammar -> D.GFCC canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = - D.GFCC an cns abs cncs + D.GFCC an cns Map.empty abs cncs where an = (i2i a) cns = map (i2i . fst) cms @@ -86,7 +86,7 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats] cncs = Map.fromList [mkConcr (i2i lang) mo | (lang,M.ModMod mo) <- cms] - mkConcr lang mo = (lang,D.Concr flags lins opers lincats lindefs printnames) + mkConcr lang mo = (lang,D.Concr flags lins opers lincats lindefs printnames params) where flags = Map.fromAscList [] ---- flags opers = Map.fromAscList [] -- opers will be created as optimization @@ -97,6 +97,7 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = lindefs = Map.fromAscList [(i2i c, mkTerm tr) | (c,GFC.CncCat _ tr _) <- tree2list (M.jments mo)] printnames = Map.fromAscList [] ---- printnames + params = Map.fromAscList [] ---- params i2i :: Ident -> C.CId i2i (IC c) = C.CId c diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 04ba13256..43ac6074e 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -15,6 +15,7 @@ import GF.Command.ParGFShell import GF.GFCC.ShowLinearize import GF.GFCC.API import GF.GFCC.Macros +import GF.Devel.PrintGFCC import GF.GFCC.AbsGFCC ---- import GF.Command.ErrM ---- @@ -79,7 +80,7 @@ valOpts flag def opts = case lookup flag flags of isOpt :: String -> [Option] -> Bool isOpt o opts = elem o [x | OOpt (Ident x) <- opts] - +-- this list must be kept sorted by the command name! allCommands :: MultiGrammar -> Map.Map String CommandInfo allCommands mgr = Map.fromAscList [ ("gr", emptyCommandInfo { @@ -109,6 +110,10 @@ allCommands mgr = Map.fromAscList [ ("p", emptyCommandInfo { exec = \opts -> return . fromTrees . concatMap (par opts). toStrings, flags = ["cat","lang"] + }), + ("pg", emptyCommandInfo { + exec = \opts _ -> return $ fromString $ prGrammar opts, + flags = ["cat","lang","printer"] }) ] where @@ -134,6 +139,11 @@ allCommands mgr = Map.fromAscList [ fromTrees ts = (ts,unlines (map showTree ts)) fromStrings ss = (map tStr ss, unlines ss) + fromString s = ([tStr s], s) toStrings ts = [s | DTr [] (AS s) [] <- ts] tStr s = DTr [] (AS s) [] + prGrammar opts = case valIdOpts "printer" "" opts of + "cats" -> unwords $ categories mgr + v -> prGFCC v gr + diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs index b8c4277f3..0c352bbb7 100644 --- a/src/GF/Devel/GFC.hs +++ b/src/GF/Devel/GFC.hs @@ -1,8 +1,8 @@ module Main where import GF.Devel.Compile +import GF.Devel.PrintGFCC import GF.Devel.GrammarToGFCC -import GF.Devel.GFCCtoJS import GF.GFCC.OptimizeGFCC import GF.GFCC.CheckGFCC import GF.GFCC.DataGFCC @@ -26,12 +26,7 @@ main = do let target = abs ++ ".gfcc" writeFile target (printGFCC gc) putStrLn $ "wrote file " ++ target - if oElem (iOpt "js") opts - then do - let js = abs ++ ".js" - writeFile js (gfcc2js gc) - putStrLn $ "wrote file " ++ js - else return () + mapM_ (alsoPrint opts abs gc) printOptions -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc _ | all ((=="gfcc") . fileSuffix) fs && oElem (iOpt "o") opts -> do @@ -51,3 +46,18 @@ check gfcc = do file2gfcc f = readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer + + +---- TODO: nicer and richer print options + +alsoPrint opts abs gr (opt,suff) = + if oElem (iOpt opt) opts + then do + let outfile = abs ++ "." ++ suff + let output = prGFCC opt gr + writeFile outfile output + putStrLn $ "wrote file " ++ outfile + else return () + +printOptions = [("haskell","hs"),("haskell_gadt","hs"),("js","js")] + diff --git a/src/GF/Devel/PrintGFCC.hs b/src/GF/Devel/PrintGFCC.hs new file mode 100644 index 000000000..462c175c7 --- /dev/null +++ b/src/GF/Devel/PrintGFCC.hs @@ -0,0 +1,14 @@ +module GF.Devel.PrintGFCC where + +import GF.GFCC.DataGFCC (GFCC,printGFCC) +import GF.Devel.GFCCtoHaskell +import GF.Devel.GFCCtoJS + +-- top-level access to code generation + +prGFCC :: String -> GFCC -> String +prGFCC printer gr = case printer of + "haskell" -> grammar2haskell gr + "haskell_gadt" -> grammar2haskellGADT gr + "js" -> gfcc2js gr + _ -> printGFCC gr