From 2f3b6779c6c66a5acadb8ad64722e0c27bc2dfcd Mon Sep 17 00:00:00 2001 From: hallgren Date: Wed, 12 Aug 2015 12:33:36 +0000 Subject: [PATCH] GF.Interactive2: cleanup --- src/compiler/GF/Interactive2.hs | 128 ++------------------------------ 1 file changed, 6 insertions(+), 122 deletions(-) diff --git a/src/compiler/GF/Interactive2.hs b/src/compiler/GF/Interactive2.hs index 03d91d2a2..abb4f7ddf 100644 --- a/src/compiler/GF/Interactive2.hs +++ b/src/compiler/GF/Interactive2.hs @@ -8,18 +8,8 @@ import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretComm import GF.Command.Commands2(flags,options,PGFEnv,pgf,concs,pgfEnv,emptyPGFEnv,allCommands) import GF.Command.Abstract import GF.Command.Parse(readCommandLine,pCommand) -import GF.Data.Operations (Err(..),chunks,err,raise,done) -import GF.Grammar hiding (Ident,isPrefixOf) -import GF.Grammar.Analyse -import GF.Grammar.Parser (runP, pExp) -import GF.Grammar.ShowTerm -import GF.Grammar.Lookup (allOpers,allOpersTo) -import GF.Compile.Rename(renameSourceTerm) ---import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError) -import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues) -import GF.Compile.TypeCheck.RConcrete as TC(inferLType,ppType) -import GF.Infra.Dependencies(depGraph) -import GF.Infra.CheckM +import GF.Data.Operations (Err(..),done) + import GF.Infra.UseIO(ioErrorText) import GF.Infra.SIO import GF.Infra.Option @@ -30,21 +20,19 @@ import qualified System.Console.Haskeline as Haskeline import qualified PGF2 as C import qualified PGF as H -import qualified PGF.Internal as H(emptyPGF,abstract,funs,lookStartCat) import Data.Char -import Data.List(nub,isPrefixOf,isInfixOf,partition) +import Data.List(isPrefixOf) import qualified Data.Map as Map ---import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.UTF8 as UTF8(fromString) + import qualified Text.ParserCombinators.ReadP as RP --import System.IO(utf8) --import System.CPUTime(getCPUTime) import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory) import System.FilePath(takeExtensions) -import Control.Exception(SomeException,fromException,evaluate,try) +import Control.Exception(SomeException,fromException,try) import Control.Monad -import GF.Text.Pretty (render) + import qualified GF.System.Signal as IO(runInterruptibly) {- #ifdef SERVER_MODE @@ -135,11 +123,6 @@ execute1 opts gfenv0 s0 = loopNewCPU gfenv' -} "q" :_ -> quit "!" :ws -> system_command ws --- "cc":ws -> compute_concrete ws --- "sd":ws -> show_deps ws --- "so":ws -> show_operations ws --- "ss":ws -> show_source ws --- "dg":ws -> dependency_graph ws "eh":ws -> eh ws "i" :ws -> import_ ws -- other special commands, working on GFEnv @@ -173,99 +156,7 @@ execute1 opts gfenv0 s0 = stop system_command ws = do restrictedSystem $ unwords ws ; continue gfenv -{- - compute_concrete ws = do - let - pOpts style q ("-table" :ws) = pOpts TermPrintTable q ws - pOpts style q ("-all" :ws) = pOpts TermPrintAll q ws - pOpts style q ("-list" :ws) = pOpts TermPrintList q ws - pOpts style q ("-one" :ws) = pOpts TermPrintOne q ws - pOpts style q ("-default":ws) = pOpts TermPrintDefault q ws - pOpts style q ("-unqual" :ws) = pOpts style Unqualified ws - pOpts style q ("-qual" :ws) = pOpts style Qualified ws - pOpts style q ws = (style,q,unwords ws) - (style,q,s) = pOpts TermPrintDefault Qualified ws - {- - (new,ws') = case ws of - "-new":ws' -> (True,ws') - "-old":ws' -> (False,ws') - _ -> (flag optNewComp opts,ws) - -} - case runP pExp (UTF8.fromString s) of - Left (_,msg) -> putStrLn msg - Right t -> putStrLn . err id (showTerm sgr style q) - . checkComputeTerm sgr - $ {-codeTerm (decodeUnicode utf8 . BS.pack)-} t - continue gfenv - - show_deps ws = do - let (os,xs) = partition (isPrefixOf "-") ws - ops <- case xs of - _:_ -> do - let ts = [t | Right t <- map (runP pExp . UTF8.fromString) xs] - err error (return . nub . concat) $ mapM (constantDepsTerm sgr) ts - _ -> error "expected one or more qualified constants as argument" - let prTerm = showTerm sgr TermPrintDefault Qualified - let size = sizeConstant sgr - let printed - | elem "-size" os = - let sz = map size ops in - unlines $ ("total: " ++ show (sum sz)) : - [prTerm f ++ "\t" ++ show s | (f,s) <- zip ops sz] - | otherwise = unwords $ map prTerm ops - putStrLn $ printed - continue gfenv - - show_operations ws = - case greatestResource sgr of - Nothing -> putStrLn "no source grammar in scope; did you import with -retain?" >> continue gfenv - Just mo -> do - let (os,ts) = partition (isPrefixOf "-") ws - let greps = [drop 6 o | o <- os, take 6 o == "-grep="] - let isRaw = elem "-raw" os - ops <- case ts of - _:_ -> do - let Right t = runP pExp (UTF8.fromString (unwords ts)) - ty <- err error return $ checkComputeTerm sgr t - return $ allOpersTo sgr ty - _ -> return $ allOpers sgr - let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops] - let printer = if isRaw - then showTerm sgr TermPrintDefault Qualified - else (render . TC.ppType) - let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs] - mapM_ putStrLn [l | l <- printed, all (flip isInfixOf l) greps] - continue gfenv - - show_source ws = do - let (os,ts) = partition (isPrefixOf "-") ws - let strip = if elem "-strip" os then stripSourceGrammar else id - let mygr = strip $ case ts of - _:_ -> mGrammar [(i,m) | (i,m) <- modules sgr, elem (render i) ts] - [] -> sgr - case 0 of - _ | elem "-detailedsize" os -> putStrLn (printSizesGrammar mygr) - _ | elem "-size" os -> do - let sz = sizesGrammar mygr - putStrLn $ unlines $ - ("total\t" ++ show (fst sz)): - [render j ++ "\t" ++ show (fst k) | (j,k) <- snd sz] - _ | elem "-save" os -> mapM_ - (\ m@(i,_) -> let file = (render i ++ ".gfh") in - restricted $ writeFile file (render (ppModule Qualified m)) >> P.putStrLn ("wrote " ++ file)) - (modules mygr) - _ -> putStrLn $ render mygr - continue gfenv - - dependency_graph ws = - do let stop = case ws of - ('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs - _ -> Nothing - restricted $ writeFile "_gfdepgraph.dot" (depGraph stop sgr) - putStrLn "wrote graph in file _gfdepgraph.dot" - continue gfenv --} eh [w] = -- Ehhh? Reads commands from a file, but does not execute them do cs <- restricted (readFile w) >>= return . map (interpretCommandLine env) . lines continue gfenv @@ -332,13 +223,6 @@ execute1 opts gfenv0 s0 = printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e) -checkComputeTerm sgr t = do - mo <- maybe (raise "no source grammar in scope") return $ greatestResource sgr - ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t - inferLType sgr [] t - t1 <- return (CN.normalForm (CN.resourceValues noOptions sgr) (L NoLoc identW) t) - checkPredefError t1 - fetchCommand :: GFEnv -> IO String fetchCommand gfenv = do path <- getAppUserDataDirectory "gf_history"