GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

macro commands

Browse Source
This commit is contained in:
aarne
2005-10-06 09:02:33 +00:00
parent a78acc722e
commit c2aeb9ae16
9 changed files with 151 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
doc/gf-history.html
View File

@@ -12,6 +12,10 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
</center>
6/10 (AR) New commands <tt>dc = define_command</tt> and
<tt>dt = define_tree</tt> to define macros in a GF session.
See <tt>help</tt> for details and examples.
<p>
5/10 (AR) Printing missing linearization rules:

19
src/GF/GFModes.hs
View File

@@ -4,9 +4,9 @@
-- Stability : (stability)
-- Portability : (portability)
--
-- > CVS $Date: 2005/04/21 16:21:04 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.7 $
-- > CVS $Date: 2005/10/06 10:02:33 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.8 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -30,7 +30,7 @@ import Data.Char (isSpace)
gfInteract :: HState -> IO HState
gfInteract st@(env,hist) = do
-- putStrFlush "> " M.F 25/01-02 prompt moved to Arch.
(s,cs) <- getCommandLines
(s,cs) <- getCommandLines st
case ifImpure cs of
-- these are the three impure commands
@@ -39,12 +39,12 @@ gfInteract st@(env,hist) = do
return st
Just (ICExecuteHistory file,_) -> do
ss <- readFileIf file
let co = pCommandLines ss
let co = pCommandLines st ss
st' <- execLinesH s co st
gfInteract st'
Just (ICEarlierCommand i,_) -> do
let line = earlierCommandH st i
co = pCommandLine $ words line
co = pCommandLine st $ words line
st' <- execLinesH line [co] st -- s would not work in execLinesH
gfInteract st'
@@ -69,7 +69,7 @@ gfInteract st@(env,hist) = do
gfBatch :: HState -> IO HState
gfBatch st@(sh,_) = do
(s,cs) <- getCommandLinesBatch
(s,cs) <- getCommandLinesBatch st
if s == "q" then return st else do
st' <- if all isSpace s then return st else do
putVe "<gfcommand>"
@@ -90,9 +90,10 @@ putVerb st@(sh,_) s = if (oElem beSilent (globalOptions sh))
batchCompile :: Options -> FilePath -> IO ()
batchCompile os file = do
let file' = mkGFC file
let st = initHState emptyShellState
let s = "i -o" +++ (unwords $ map ('-':) $ words $ prOpts os) +++ file
let cs = pCommandLines s
execLines True cs (initHState emptyShellState)
let cs = pCommandLines st s
execLines True cs st
return ()
mkGFC = reverse . ("cfg" ++) . dropWhile (/='.') . reverse

6
src/GF/Infra/Option.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Date: 2005/10/06 10:02:33 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.31 $
-- > CVS $Revision: 1.32 $
--
-- Options and flags used in GF shell commands and files.
--
@@ -210,6 +210,7 @@ tableLin = iOpt "table"
defaultLinOpts = [firstLin]
useUTF8 = iOpt "utf8"
showLang = iOpt "lang"
showDefs = iOpt "defs"
withMetas = iOpt "metas"
-- ** other
@@ -221,6 +222,7 @@ beVerbose, showInfo, beSilent, emitCode, getHelp,
stripQualif, nostripQualif, showAll, fromSource :: Option
beVerbose = iOpt "v"
invertGrep = iOpt "v" --- same letter in unix
showInfo = iOpt "i"
beSilent = iOpt "s"
emitCode = iOpt "o"

75
src/GF/Shell.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/05 20:02:19 $
-- > CVS $Date: 2005/10/06 10:02:33 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.43 $
-- > CVS $Revision: 1.44 $
--
-- GF shell command interpreter.
-----------------------------------------------------------------------------
@@ -57,7 +57,7 @@ import GF.Data.Zipper ----
import GF.Data.Operations
import GF.Infra.UseIO
import GF.Text.UTF8 (encodeUTF8)
import Data.Char (isDigit)
---- import qualified GrammarToGramlet as Gr
---- import qualified GrammarToCanonXML2 as Canon
@@ -72,31 +72,67 @@ type CommandLine = (CommandOpt, CommandArg, [CommandOpt])
type SrcTerm = G.Term
-- | history & CPU
type HState = (ShellState,([String],Integer))
type HState = (ShellState,([String],Integer,ShMacros,ShTerms))
type ShMacros = [(String,[String])] -- dc %c = ... #1 ... #2 ...
type ShTerms = [(String,Tree)] -- dt $e = f ...
type ShellIO = (HState, CommandArg) -> IO (HState, CommandArg)
initHState :: ShellState -> HState
initHState st = (st,([],0))
initHState st = (st,([],0,[],[]))
cpuHState :: HState -> Integer
cpuHState (_,(_,i)) = i
cpuHState (_,(_,i,_,_)) = i
optsHState :: HState -> Options
optsHState (st,_) = globalOptions st
putHStateCPU :: Integer -> HState -> HState
putHStateCPU cpu (st,(h,_)) = (st,(h,cpu))
putHStateCPU cpu (st,(h,_,c,t)) = (st,(h,cpu,c,t))
updateHistory :: String -> HState -> HState
updateHistory s (st,(h,cpu)) = (st,(s:h,cpu))
updateHistory s (st,(h,cpu,c,t)) = (st,(s:h,cpu,c,t))
addShMacro :: (String,[String]) -> HState -> HState
addShMacro m (st,(h,cpu,c,t)) = (st,(h,cpu,m:c,t))
addShTerm :: (String,Tree) -> HState -> HState
addShTerm m (st,(h,cpu,c,t)) = (st,(h,cpu,c,m:t))
resolveShMacro :: HState -> String -> [String] -> [String]
resolveShMacro st@(_,(_,_,cs,_)) c args = case lookup c cs of
Just def -> map subst def
_ -> [] ----
where
subst s = case s of
"#1" -> unwords args
_ -> s
--- so far only one arg allowed - how to determine arg boundaries?
{-
subst s = case s of
'#':d@(_:_) | all isDigit d ->
let i = read d in if i > lg then s else args !! (i-1) -- #1 is first
_ -> s
lg = length args
-}
lookupShTerm :: HState -> String -> Maybe Tree
lookupShTerm st@(_,(_,_,_,ts)) c = lookup c ts
txtHelpMacros :: HState -> String
txtHelpMacros (_,(_,_,cs,ts)) = unlines $
["Defined commands:",""] ++
[c +++ "=" +++ unwords def | (c,def) <- cs] ++
["","Defined terms:",""] ++
[c +++ "=" +++ prt_ def | (c,def) <- ts]
-- | empty command if index over
earlierCommandH :: HState -> Int -> String
earlierCommandH (_,(h,_)) = ((h ++ repeat "") !!)
earlierCommandH (_,(h,_,_,_)) = ((h ++ repeat "") !!)
execLinesH :: String -> [CommandLine] -> HState -> IO HState
execLinesH s cs hst@(st, (h, _)) = do
execLinesH s cs hst@(st, (h,_,_,_)) = do
(_,st') <- execLines True cs hst
cpu <- prOptCPU (optsHState st') (cpuHState hst)
return $ putHStateCPU cpu $ updateHistory s st'
@@ -125,7 +161,7 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do
-- | individual commands possibly piped: value returned; this is not a state monad
execC :: CommandOpt -> ShellIO
execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case comm of
CImport file | oElem fromExamples opts -> do
es <- liftM nub $ getGFEFiles opts file
@@ -151,6 +187,17 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
CPrintHistory -> (returnArg $ AString $ unlines $ reverse h) sa
-- good to have here for piping; eh and ec must be done on outer level
CDefineCommand c args -> return (addShMacro (c,args) sh, AUnit)
CDefineTerm c -> do
let
a' = case a of
ASTrm _ -> s2t a
AString _ -> s2t a
_ -> a
case a' of
ATrms [trm] -> return (addShTerm (c,trm) sh, AUnit)
_ -> returnArg (AError "illegal term definition") sa
CLinearize []
| oElem showMulti opts ->
changeArg (opTS2CommandArg (unlines. linearizeToAll
@@ -277,7 +324,8 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
CHelp (Just c) -> returnArg (AString (txtHelpCommand c)) sa
CHelp _ -> case opts0 of
Opts [o] | o == showAll -> returnArg (AString txtHelpFile) sa
Opts [o] | o == showAll -> returnArg (AString txtHelpFile) sa
Opts [o] | o == showDefs -> returnArg (AString (txtHelpMacros sh)) sa
Opts [o] -> returnArg (AString (txtHelpCommand ('-':prOpt o))) sa
_ -> returnArg (AString txtHelpFileSummary) sa
@@ -312,6 +360,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
cgr = canModules st
s2t a = case a of
ASTrm ('$':c) -> maybe (AError "undefined term") (ATrms . return) $ lookupShTerm sh c
ASTrm s -> err AError (ATrms . return) $ string2treeErr gro s
AString s -> err AError (ATrms . return) $ string2treeErr gro s
_ -> a
@@ -329,7 +378,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
then (putStrLn ("Warning: discontinuous category" +++ prt_ c))
else (return ())
grep ms s = (if oElem beVerbose opts then not else id) $ grepv ms s --- -v
grep ms s = (if oElem invertGrep opts then not else id) $ grepv ms s --- -v
grepv ms s = case s of
_:cs -> isPrefixOf ms s || grepv ms cs
_ -> isPrefixOf ms s

9
src/GF/Shell/Commands.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/17 15:13:55 $
-- > CVS $Date: 2005/10/06 10:02:33 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.41 $
-- > CVS $Revision: 1.42 $
--
-- temporary hacks for GF 2.0
--
@@ -162,8 +162,9 @@ execCommand env c s = case c of
return (startEditEnv emptyShellState, initSState)
CCEnvGFShell command -> do
let cs = PShell.pCommandLines command
(msg,(env',_)) <- Shell.execLines False cs (Shell.initHState env)
let hs = Shell.initHState env
let cs = PShell.pCommandLines hs command
(msg,(env',_)) <- Shell.execLines False cs hs
return (env', changeMsg msg s) ----
CCEnvOpenTerm file -> do

24
src/GF/Shell/HelpFile.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/05 20:02:19 $
-- > CVS $Date: 2005/10/06 10:02:34 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.14 $
-- > CVS $Revision: 1.15 $
--
-- Help on shell commands. Generated from HelpFile by 'make help'.
-- PLEASE DON'T EDIT THIS FILE.
@@ -90,6 +90,23 @@ txtHelpFile =
"\ns, strip: s" ++
"\n Prune the state by removing source and resource modules." ++
"\n" ++
"\ndc, define_command Name Anything" ++
"\n Add a new defined command. The Name must star with '%'. Later," ++
"\n if 'Name X' is used, it is replaced by Anything where #1 is replaced" ++
"\n by X. Currently at most one argument is possible. To see" ++
"\n definitions in scope, use help -defs." ++
"\n examples:" ++
"\n dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe -- translate NPs" ++
"\n %tnp \"this man\" | p -lang=Swe -- translate and parse" ++
"\n" ++
"\ndt, define_term Name Tree" ++
"\n Add a constant for a tree. The constant can later be called by" ++
"\n prefixing it with '$'. It is not yet usable as a subterm. To see" ++
"\n definitions in scope, use help -defs." ++
"\n examples:" ++
"\n p -cat=NP \"this man\" | dt tm -- define tm as parse result" ++
"\n l -all $tm -- linearize tm in all forms" ++
"\n" ++
"\n-- commands that give information about the state" ++
"\n" ++
"\npg, print_grammar: pg" ++
@@ -445,7 +462,8 @@ txtHelpFile =
"\n Displays the paragraph concerning the command from this help file." ++
"\n Without the argument, shows the first lines of all paragraphs." ++
"\n options" ++
"\n -all show the whole help file" ++
"\n -all show the whole help file" ++
"\n -defs show user-defined commands and terms" ++
"\n examples:" ++
"\n h print_grammar -- show all information on the pg command" ++
"\n" ++

36
src/GF/Shell/PShell.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/05 20:02:20 $
-- > CVS $Date: 2005/10/06 10:02:34 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.26 $
-- > CVS $Revision: 1.27 $
--
-- parsing GF shell commands. AR 11\/11\/2001
-----------------------------------------------------------------------------
@@ -30,18 +30,19 @@ import System.IO.Error
-- parsing GF shell commands. AR 11/11/2001
-- | getting a sequence of command lines as input
getCommandLines :: IO (String,[CommandLine])
getCommandLines = do
getCommandLines :: HState -> IO (String,[CommandLine])
getCommandLines st = do
s <- fetchCommand "> "
return (s,pCommandLines s)
return (s,pCommandLines st s)
getCommandLinesBatch :: IO (String,[CommandLine])
getCommandLinesBatch = do
getCommandLinesBatch :: HState -> IO (String,[CommandLine])
getCommandLinesBatch st = do
s <- catch getLine (\e -> if isEOFError e then return "q" else ioError e)
return $ (s,pCommandLines s)
return $ (s,pCommandLines st s)
pCommandLines :: String -> [CommandLine]
pCommandLines = map pCommandLine . concatMap (chunks ";;" . wordsLits) . lines
pCommandLines :: HState -> String -> [CommandLine]
pCommandLines st =
map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines
-- | Like 'words', but does not split on whitespace inside
-- double quotes.
@@ -60,23 +61,25 @@ unquote :: String -> String
unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs
unquote s = s
pCommandLine :: [String] -> CommandLine
pCommandLine s = pFirst (chks s) where
pCommandLine :: HState -> [String] -> CommandLine
pCommandLine st (dc:c:def) | abbrevCommand dc == "dc" = ((CDefineCommand c def, noOptions),AUnit,[])
pCommandLine st s = pFirst (chks s) where
pFirst cos = case cos of
(c,os,[a]) : cs -> ((c,os), a, pCont cs)
_ -> ((CVoid,noOptions), AError "no parse", [])
pCont cos = case cos of
(c,os,_) : cs -> (c,os) : pCont cs
_ -> []
chks = map pCommandOpt . chunks "|"
chks = map (pCommandOpt st) . chunks "|"
pCommandOpt :: [String] -> (Command, Options, [CommandArg])
pCommandOpt (w:ws) = let
pCommandOpt :: HState -> [String] -> (Command, Options, [CommandArg])
pCommandOpt st (c@('%':_):args) = pCommandOpt st $ resolveShMacro st c args
pCommandOpt _ (w:ws) = let
(os, co) = getOptions "-" ws
(comm, args) = pCommand (abbrevCommand w:co)
in
(comm, os, args)
pCommandOpt s = (CVoid, noOptions, [AError "no parse"])
pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"])
pInputString :: String -> [CommandArg]
pInputString s = case s of
@@ -104,6 +107,7 @@ pCommand ws = case ws of
"cl" : f : [] -> aUnit (CConvertLatex f)
"ph" : [] -> aUnit CPrintHistory
"dt" : f : t -> aTerm (CDefineTerm (unquote f)) t
"l" : s -> aTermLi CLinearize s

9
src/GF/Shell/ShellCommands.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/05 20:02:20 $
-- > CVS $Date: 2005/10/06 10:02:34 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.40 $
-- > CVS $Revision: 1.41 $
--
-- The datatype of shell commands and the list of their options.
-----------------------------------------------------------------------------
@@ -40,6 +40,9 @@ data Command =
| CTransformGrammar FilePath
| CConvertLatex FilePath
| CDefineCommand String [String]
| CDefineTerm String
| CLinearize [()] ---- parameters
| CParse
| CTranslate Language Language
@@ -200,7 +203,7 @@ optionsOfCommand co = case co of
CPrintMultiGrammar -> both "utf8 utf8id" "printer"
CPrintSourceGrammar -> both "utf8" "printer"
CHelp _ -> opts "all filter length lexer unlexer printer transform depth number"
CHelp _ -> opts "all defs filter length lexer unlexer printer transform depth number"
CImpure ICEditSession -> both "f" "file"
CImpure ICTranslateSession -> both "f langs" "cat"

20
src/HelpFile
View File

@@ -61,6 +61,23 @@ sf, set_flags: sf Flag*
s, strip: s
Prune the state by removing source and resource modules.
dc, define_command Name Anything
Add a new defined command. The Name must star with '%'. Later,
if 'Name X' is used, it is replaced by Anything where #1 is replaced
by X. Currently at most one argument is possible. To see
definitions in scope, use help -defs.
examples:
dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe -- translate NPs
%tnp "this man" | p -lang=Swe -- translate and parse
dt, define_term Name Tree
Add a constant for a tree. The constant can later be called by
prefixing it with '$'. It is not yet usable as a subterm. To see
definitions in scope, use help -defs.
examples:
p -cat=NP "this man" | dt tm -- define tm as parse result
l -all $tm -- linearize tm in all forms
-- commands that give information about the state
pg, print_grammar: pg
@@ -416,7 +433,8 @@ h, help: h Command?
Displays the paragraph concerning the command from this help file.
Without the argument, shows the first lines of all paragraphs.
options
-all show the whole help file
-all show the whole help file
-defs show user-defined commands and terms
examples:
h print_grammar -- show all information on the pg command