diff --git a/src/GF/Devel/Compile.hs b/src/GF/Devel/Compile.hs index 916cb961e..a89ed4624 100644 --- a/src/GF/Devel/Compile.hs +++ b/src/GF/Devel/Compile.hs @@ -29,9 +29,9 @@ import GF.Devel.Arch import Control.Monad import System.Directory -batchCompile :: [FilePath] -> IO SourceGrammar -batchCompile files = do - let defOpts = options [emitCode] +batchCompile :: Options -> [FilePath] -> IO SourceGrammar +batchCompile opts files = do + let defOpts = addOptions opts (options [emitCode]) Ok (_,gr) <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files return gr @@ -79,12 +79,12 @@ compileEnvShSt env@(_,sgr) fs = (0,sgr2) where compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv compileOne opts env@(_,srcgr) file = do - let putp s = putPointE opts (s ++ "\n") + let putp s = putPointE opts ("\n" ++ s) let putpp = putPointEsil opts let putpOpt v m act | oElem beVerbose opts = putp v act | oElem beSilent opts = putpp v act - | otherwise = ioeIO (putStrFlush m) >> act + | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act let gf = fileSuffix file let path = justInitPath file diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs index ba2759c87..da5725d3d 100644 --- a/src/GF/Devel/GFC.hs +++ b/src/GF/Devel/GFC.hs @@ -3,6 +3,7 @@ module Main where import GF.Devel.Compile import GF.Devel.GrammarToGFCC import GF.Devel.UseIO +import GF.Infra.Option ---import GF.Devel.PrGrammar --- import System @@ -10,15 +11,16 @@ import System main = do xx <- getArgs - case xx of - "-help":[] -> putStrLn "usage: gfc (--make) FILES" - "--make":fs -> do - gr <- batchCompile fs + let (opts,fs) = getOptions "-" xx + case opts of + _ | oElem (iOpt "help") opts -> putStrLn "usage: gfc (--make) FILES" + _ | oElem (iOpt "-make") opts -> do + gr <- batchCompile opts fs let name = justModuleName (last fs) let (abs,gc) = prGrammar2gfcc name gr let target = abs ++ ".gfcc" writeFile target gc putStrLn $ "wrote file " ++ target _ -> do - mapM_ batchCompile (map return xx) + mapM_ (batchCompile opts) (map return fs) putStrLn "Done." diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs index c8edd0647..0baa3bd6d 100644 --- a/src/GF/Devel/GrammarToGFCC.hs +++ b/src/GF/Devel/GrammarToGFCC.hs @@ -16,6 +16,7 @@ import GF.Data.Operations import GF.Text.UTF8 import Data.List +import Data.Char (isDigit) import qualified Data.Map as Map import Debug.Trace ---- @@ -79,6 +80,8 @@ mkCType t = case t of mkTerm :: Term -> C.Term mkTerm tr = case tr of Vr (IA (_,i)) -> C.V i + Vr (IC s) | isDigit (last s) -> + C.V (read (reverse (takeWhile (/='_') (reverse s)))) ---- from gf parser of gfc EInt i -> C.C $ fromInteger i -- record parameter alias - created in gfc preprocessing R [(LIdent "_", (_,i)), (LIdent "__", (_,t))] -> C.RP (mkTerm i) (mkTerm t) @@ -292,6 +295,8 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of -- this goes recursively into tables (ignored) and records (accumulated) getLab tr = case tr of Vr (IA (cat, _)) -> return (identC cat,[]) + Vr (IC s) -> return (identC cat,[]) where + cat = init (reverse (dropWhile (/='_') (reverse s))) ---- from gf parser P p lab2 -> do (cat,labs) <- getLab p return (cat,labs++[lab2]) diff --git a/src/GF/Infra/CompactPrint.hs b/src/GF/Infra/CompactPrint.hs index eb8be2292..56aaf4d64 100644 --- a/src/GF/Infra/CompactPrint.hs +++ b/src/GF/Infra/CompactPrint.hs @@ -1,11 +1,11 @@ module GF.Infra.CompactPrint where import Data.Char -compactPrint = concat . map spaceIf . words +compactPrint = tail . concat . map spaceIf . words spaceIf w = case w of _ | keyword w -> "\n" ++ w c:cs | isAlpha c || isDigit c -> " " ++ w _ -> w -keyword w = elem w ["cat","fun","lin","lincat","oper","param"] +keyword w = elem w ["cat","fun","lin","lincat","lindef","oper","param"]