Merge branch 'master' into c-runtime

src/compiler/GF/Command/Commands.hs

@@ -1,9 +1,9 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
 module GF.Command.Commands (
   HasPGF(..),pgfCommands,
   options,flags,
   ) where
-import Prelude hiding (putStrLn)
+import Prelude hiding (putStrLn,(<>))
 
 import PGF2
 import PGF2.Internal(writePGF)
@@ -31,10 +31,13 @@ import qualified Data.Map as Map
 import GF.Text.Pretty
 import Data.List (sort)
 import Control.Monad(mplus)
+import qualified Control.Monad.Fail as Fail
+--import Debug.Trace
+
 
 class (Functor m,Monad m,MonadSIO m) => HasPGF m where getPGF :: m (Maybe PGF)
 
-instance (Monad m,HasPGF m) => TypeCheckArg m where
+instance (Monad m,HasPGF m,Fail.MonadFail m) => TypeCheckArg m where
   typeCheckArg e = do mb_pgf <- getPGF
                       case mb_pgf of
                         Just pgf -> either fail
@@ -708,16 +711,10 @@ pgfCommands = Map.fromList [
    optLins pgf opts ts = concatMap (optLin pgf opts) ts
    optLin pgf opts t =
      case opts of
-       _ | isOpt "treebank" opts && isOpt "chunks" opts ->
-         (abstractName pgf ++ ": " ++ showExpr [] t) :
-         [lang ++ ": " ++ li | (lang,li) <- linChunks pgf opts t] --linear pgf opts lang t | lang <- optLangs pgf opts]
        _ | isOpt "treebank" opts ->
          (abstractName pgf ++ ": " ++ showExpr [] t) :
          [concreteName concr ++ ": " ++ s | concr <- optLangs pgf opts, s<-linear opts concr t]
-       _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t   
        _ -> [s | concr <- optLangs pgf opts, s <- linear opts concr t]
-   linChunks pgf opts t = 
-     [(concreteName concr, unwords (intersperse "<+>" (map (unlines . linear opts concr) (treeChunks t)))) | concr <- optLangs pgf opts]
 
    linear :: [Option] -> Concr -> Expr -> [String]
    linear opts concr = case opts of
@@ -916,3 +913,7 @@ stanzas = map unlines . chop . lines where
   chop ls = case break (=="") ls of
     (ls1,[])  -> [ls1]
     (ls1,_:ls2) -> ls1 : chop ls2
+
+#if !(MIN_VERSION_base(4,9,0))
+errorWithoutStackTrace = error
+#endif

src/compiler/GF/Command/CommonCommands.hs

@@ -14,6 +14,7 @@ import GF.Command.Abstract --(isOpt,valStrOpts,prOpt)
 import GF.Text.Pretty
 import GF.Text.Transliterations
 import GF.Text.Lexing(stringOp,opInEnv)
+import Data.Char (isSpace)
 
 import PGF2(showExpr)
 
@@ -165,7 +166,8 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
        restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo
        fmap fromString $ restricted $ readFile tmpo,
        -}
-       fmap fromString . restricted . readShellProcess syst $ toString arg,
+       fmap (fromStrings . lines) . restricted . readShellProcess syst . unlines . map (dropWhile (=='\n')) $ toStrings $ arg,
+
      flags = [
        ("command","the system command applied to the argument")
        ],

src/compiler/GF/Command/Interpreter.hs

@@ -11,6 +11,8 @@ import PGF2
 
 import Control.Monad(when)
 import qualified Data.Map as Map
+import GF.Infra.UseIO (Output)
+import qualified Control.Monad.Fail as Fail
 
 data CommandEnv m = CommandEnv {
   commands      :: Map.Map String (CommandInfo m),
@@ -22,6 +24,7 @@ data CommandEnv m = CommandEnv {
 mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
 
 --interpretCommandLine :: CommandEnv -> String -> SIO ()
+interpretCommandLine :: (Fail.MonadFail m, Output m, TypeCheckArg m) => CommandEnv m -> String -> m ()
 interpretCommandLine env line =
   case readCommandLine line of
     Just []    -> return ()

src/compiler/GF/Command/SourceCommands.hs

@@ -18,8 +18,8 @@ import GF.Grammar.Parser (runP, pExp)
 import GF.Grammar.ShowTerm
 import GF.Grammar.Lookup (allOpers,allOpersTo)
 import GF.Compile.Rename(renameSourceTerm)
-import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)
-import GF.Compile.TypeCheck.RConcrete as TC(inferLType,ppType)
+import GF.Compile.Compute.Concrete(normalForm,resourceValues)
+import GF.Compile.TypeCheck.Concrete as TC(inferLType,ppType)
 import GF.Infra.Dependencies(depGraph)
 import GF.Infra.CheckM(runCheck)
 
@@ -259,7 +259,7 @@ checkComputeTerm os sgr t =
      ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
                                 inferLType sgr [] t
      let opts = modifyFlags (\fs->fs{optTrace=isOpt "trace" os})
-         t1 = CN.normalForm (CN.resourceValues opts sgr) (L NoLoc identW) t
+         t1 = normalForm (resourceValues opts sgr) (L NoLoc identW) t
          t2 = evalStr t1
      checkPredefError t2
   where

src/compiler/GF/Command/TreeOperations.hs

@@ -1,10 +1,9 @@
 module GF.Command.TreeOperations (
   treeOp,
   allTreeOps,
-  treeChunks
   ) where
 
-import PGF2(Expr,PGF,Fun,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
+import PGF2(Expr,PGF,Fun,compute,mkApp,unApp,unMeta,exprSize,exprFunctions)
 import Data.List
 
 type TreeOp = [Expr] -> [Expr]
@@ -34,16 +33,6 @@ largest = reverse . smallest
 smallest :: [Expr] -> [Expr]
 smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))
 
-treeChunks :: Expr -> [Expr]
-treeChunks = snd . cks where
-  cks t = 
-    case unapply t of
-      (t, ts) -> case unMeta t of
-                   Just _  -> (False,concatMap (snd . cks) ts)
-                   Nothing -> case unzip (map cks ts) of
-                                (bs,_) | and bs      -> (True, [t])
-                                (_,cts)              -> (False,concat cts)
-
 subtrees :: Expr -> [Expr]
 subtrees t = t : case unApp t of
   Just (f,ts) -> concatMap subtrees ts