From cc151c42790e02d60d6a0ab18c9c56da76f0ea51 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Sun, 13 Sep 2009 15:39:11 +0000
Subject: [PATCH] added needsTypeCheck parameter to CommandInfo. The argument
 to the command is typechecked only if needsTypeCheck=True

---
 src/GF/Command/Commands.hs    | 33 ++++++++++++++++++++++-----------
 src/GF/Command/Interpreter.hs | 18 ++++++++++--------
 2 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index 5e655c360..282bd3066 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -5,6 +5,7 @@ module GF.Command.Commands (
   isOpt,
   options,
   flags,
+  needsTypeCheck,
   CommandInfo,
   CommandOutput
   ) where
@@ -49,7 +50,8 @@ data CommandInfo = CommandInfo {
   longname :: String,
   options  :: [(String,String)],
   flags    :: [(String,String)],
-  examples :: [String]
+  examples :: [String],
+  needsTypeCheck :: Bool
   }
 
 emptyCommandInfo :: CommandInfo
@@ -61,7 +63,8 @@ emptyCommandInfo = CommandInfo {
   longname = "",
   options = [],
   flags = [],
-  examples = []
+  examples = [],
+  needsTypeCheck = True
   }
 
 lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
@@ -117,14 +120,16 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      syntax   = "! SYSTEMCOMMAND",
      examples = [
        "! ls *.gf   -- list all GF files in the working directory"
-       ]
+       ],
+     needsTypeCheck = False
      }),
   ("?", emptyCommandInfo {
      synopsis = "system pipe: send value from previous command to a system command",
      syntax   = "? SYSTEMCOMMAND",
      examples = [
        "gt | l | ? wc  -- generate, linearize, word-count"
-       ]
+       ],
+     needsTypeCheck = False
      }),
 
   ("aw", emptyCommandInfo {
@@ -179,7 +184,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ("all","pick all strings (forms and variants) from records and tables"),
        ("table","show all strings labelled by parameters"),
        ("unqual","hide qualifying module names")
-       ]
+       ],
+     needsTypeCheck = False
      }),
   ("dc",  emptyCommandInfo {
      longname = "define_command",
@@ -192,7 +198,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        "trees can be arguments. Currently at most one argument is possible.",
        "This command must be a line of its own, and thus cannot be a part",
        "of a pipe."
-       ] 
+       ],
+     needsTypeCheck = False
      }),
   ("dt",  emptyCommandInfo {
      longname = "define_tree",
@@ -211,7 +218,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ("dt ex UseN man_N                         -- define ex as string"),
        ("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),
        ("l -lang=LangSwe %ex | ps -to_utf8        -- linearize the tree ex")
-       ] 
+       ],
+     needsTypeCheck = False
      }),
   ("e",  emptyCommandInfo {
      longname = "empty",
@@ -287,7 +295,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
                    Just info -> commandHelp True (co,info)
                    _ -> "command not found"
           _ -> commandHelpAll cod env opts
-       in return (fromString msg) 
+       in return (fromString msg),
+     needsTypeCheck = False
      }),
   ("i", emptyCommandInfo {
      longname = "import",
@@ -306,7 +315,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ("retain","retain operations (used for cc command)"),
        ("src",   "force compilation from source"),
        ("v",     "be verbose - show intermediate status information")
-       ]
+       ],
+     needsTypeCheck = False
      }),
   ("l", emptyCommandInfo {
      longname = "linearize",
@@ -367,7 +377,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ("lang","language of the quiz"),
        ("cat","category of the quiz"),
        ("number","maximum number of questions")
-       ] 
+       ]
      }),
 
   ("p", emptyCommandInfo {
@@ -520,7 +530,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      examples = [
       "se cp1251 -- set encoding to cp1521",
       "se utf8   -- set encoding to utf8 (default)"
-      ]
+      ],
+     needsTypeCheck = False
     }),
   ("sp", emptyCommandInfo {
      longname = "system_pipe",
diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs
index 2ace4cde6..17ff6aa29 100644
--- a/src/GF/Command/Interpreter.hs
+++ b/src/GF/Command/Interpreter.hs
@@ -56,7 +56,7 @@ interpretPipe enc env cs = do
    interc es comm@(Command co opts arg) = case co of
      '%':f -> case Map.lookup f (commandmacros env) of
        Just css ->
-         case getCommandTrees env arg es of
+         case getCommandTrees env False arg es of
            Right es -> do mapM_ (interpretPipe enc env) (appLine es css) 
                           return ([],[])
            Left msg -> do putStrLn ('\n':msg)
@@ -98,7 +98,7 @@ getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo,[Opt
 getCommand env es co@(Command c opts arg) = do
   info <- getCommandInfo  env c
   checkOpts info opts
-  es   <- getCommandTrees env arg es
+  es   <- getCommandTrees env (needsTypeCheck info) arg es
   return (info,opts,es)
 
 getCommandInfo :: CommandEnv -> String -> Either String CommandInfo
@@ -117,14 +117,16 @@ checkOpts info opts =
     [o] -> fail $ "option not interpreted: " ++ o
     os  -> fail $ "options not interpreted: " ++ unwords os
 
-getCommandTrees :: CommandEnv -> Argument -> [Expr] -> Either String [Expr]
-getCommandTrees env a es =
+getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]
+getCommandTrees env needsTypeCheck a es =
   case a of
     AMacro m -> case Map.lookup m (expmacros env) of
                   Just e -> return [e]
                   _      -> return [] 
-    AExpr e -> case inferExpr (multigrammar env) e of
-                 Left tcErr   -> fail $ render (ppTcError tcErr)
-                 Right (e,ty) -> return [e] -- ignore piped
+    AExpr e -> if needsTypeCheck
+                 then case inferExpr (multigrammar env) e of
+                        Left tcErr   -> fail $ render (ppTcError tcErr)
+                        Right (e,ty) -> return [e] -- ignore piped
+                 else return [e]
     ANoArg  -> return es  -- use piped
-  
+