summaryrefslogtreecommitdiff
path: root/src/GF/Command/Interpreter.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
committerkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
commitf85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch)
tree667b886a5e3a4b026a63d4e3597f32497d824761 /src/GF/Command/Interpreter.hs
parentd88a865faff59c98fc91556ff8700b10ee5f2df8 (diff)
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/GF/Command/Interpreter.hs')
-rw-r--r--src/GF/Command/Interpreter.hs132
1 files changed, 0 insertions, 132 deletions
diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs
deleted file mode 100644
index ff84da8a3..000000000
--- a/src/GF/Command/Interpreter.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-module GF.Command.Interpreter (
- CommandEnv (..),
- mkCommandEnv,
- emptyCommandEnv,
- interpretCommandLine,
- interpretPipe,
- getCommandOp
- ) where
-
-import GF.Command.Commands
-import GF.Command.Abstract
-import GF.Command.Parse
-import PGF
-import PGF.Data
-import PGF.Morphology
-import GF.System.Signal
-import GF.Infra.UseIO
-import GF.Infra.Option
-
-import Text.PrettyPrint
-import Control.Monad.Error
-import qualified Data.Map as Map
-
-data CommandEnv = CommandEnv {
- multigrammar :: PGF,
- morphos :: Map.Map Language Morpho,
- commands :: Map.Map String CommandInfo,
- commandmacros :: Map.Map String CommandLine,
- expmacros :: Map.Map String Expr
- }
-
-mkCommandEnv :: Encoding -> PGF -> CommandEnv
-mkCommandEnv enc pgf =
- let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in
- CommandEnv pgf mos (allCommands enc (pgf, mos)) Map.empty Map.empty
-
-emptyCommandEnv :: CommandEnv
-emptyCommandEnv = mkCommandEnv UTF_8 emptyPGF
-
-interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO ()
-interpretCommandLine enc env line =
- case readCommandLine line of
- Just [] -> return ()
- Just pipes -> mapM_ (interpretPipe enc env) pipes
- Nothing -> putStrLnFlush "command not parsed"
-
-interpretPipe enc env cs = do
- v@(_,s) <- intercs ([],"") cs
- putStrLnFlush $ enc s
- return v
- where
- intercs treess [] = return treess
- intercs (trees,_) (c:cs) = do
- treess2 <- interc trees c
- intercs treess2 cs
- interc es comm@(Command co opts arg) = case co of
- '%':f -> case Map.lookup f (commandmacros env) of
- Just css ->
- case getCommandTrees env False arg es of
- Right es -> do mapM_ (interpretPipe enc env) (appLine es css)
- return ([],[])
- Left msg -> do putStrLn ('\n':msg)
- return ([],[])
- Nothing -> do
- putStrLn $ "command macro " ++ co ++ " not interpreted"
- return ([],[])
- _ -> interpret enc env es comm
- appLine es = map (map (appCommand es))
-
--- macro definition applications: replace ?i by (exps !! i)
-appCommand :: [Expr] -> Command -> Command
-appCommand xs c@(Command i os arg) = case arg of
- AExpr e -> Command i os (AExpr (app e))
- _ -> c
- where
- app e = case e of
- EAbs b x e -> EAbs b x (app e)
- EApp e1 e2 -> EApp (app e1) (app e2)
- ELit l -> ELit l
- EMeta i -> xs !! i
- EFun x -> EFun x
-
--- return the trees to be sent in pipe, and the output possibly printed
-interpret :: (String -> String) -> CommandEnv -> [Expr] -> Command -> IO CommandOutput
-interpret enc env trees comm =
- case getCommand env trees comm of
- Left msg -> do putStrLn ('\n':msg)
- return ([],[])
- Right (info,opts,trees) -> do tss@(_,s) <- exec info opts trees
- if isOpt "tr" opts
- then putStrLn (enc s)
- else return ()
- return tss
-
--- analyse command parse tree to a uniform datastructure, normalizing comm name
---- the env is needed for macro lookup
-getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo,[Option],[Expr])
-getCommand env es co@(Command c opts arg) = do
- info <- getCommandInfo env c
- checkOpts info opts
- es <- getCommandTrees env (needsTypeCheck info) arg es
- return (info,opts,es)
-
-getCommandInfo :: CommandEnv -> String -> Either String CommandInfo
-getCommandInfo env cmd =
- case lookCommand (getCommandOp cmd) (commands env) of
- Just info -> return info
- Nothing -> fail $ "command " ++ cmd ++ " not interpreted"
-
-checkOpts :: CommandInfo -> [Option] -> Either String ()
-checkOpts info opts =
- case
- [o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] ++
- [o | OFlag o _ <- opts, notElem o (map fst (flags info))]
- of
- [] -> return ()
- [o] -> fail $ "option not interpreted: " ++ o
- os -> fail $ "options not interpreted: " ++ unwords os
-
-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 -> 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
-