mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-19 01:39:32 -06:00
"Committed_by_peb"
This commit is contained in:
peb
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/18 19:21:14 $
|
||||
-- > CVS $Date: 2005/02/24 11:46:34 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -47,6 +47,11 @@ prIdent i = case i of
|
||||
IAV (s,b,j) -> s ++ "_" ++ show b ++ "_" ++ show j
|
||||
IW -> "_"
|
||||
|
||||
identC :: String -> Ident
|
||||
identV :: (Int, String) -> Ident
|
||||
identA :: (String, Int) -> Ident
|
||||
identAV:: (String, Int, Int) -> Ident
|
||||
identW :: Ident
|
||||
(identC, identV, identA, identAV, identW) =
|
||||
(IC, IV, IA, IAV, IW)
|
||||
|
||||
@@ -54,18 +59,22 @@ prIdent i = case i of
|
||||
-- ident s = IC s
|
||||
|
||||
-- | to mark argument variables
|
||||
argIdent :: Int -> Ident -> Int -> Ident
|
||||
argIdent 0 (IC c) i = identA (c,i)
|
||||
argIdent b (IC c) i = identAV (c,b,i)
|
||||
|
||||
-- | used in lin defaults
|
||||
strVar :: Ident
|
||||
strVar = identA ("str",0)
|
||||
|
||||
-- | wild card
|
||||
wildIdent :: Ident
|
||||
wildIdent = identW
|
||||
|
||||
isWildIdent :: Ident -> Bool
|
||||
isWildIdent = (== wildIdent)
|
||||
|
||||
newIdent :: Ident
|
||||
newIdent = identC "#h"
|
||||
|
||||
mkIdent :: String -> Int -> Ident
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Date: 2005/02/24 11:46:35 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
-- > CVS $Revision: 1.20 $
|
||||
--
|
||||
-- Datastructures and functions for modules, common to GF and GFC.
|
||||
--
|
||||
@@ -149,7 +149,10 @@ data OpenQualif =
|
||||
| OQIncomplete
|
||||
deriving (Eq,Show)
|
||||
|
||||
oSimple :: i -> OpenSpec i
|
||||
oSimple = OSimple OQNormal
|
||||
|
||||
oQualif :: i -> i -> OpenSpec i
|
||||
oQualif = OQualif OQNormal
|
||||
|
||||
data ModuleStatus =
|
||||
@@ -162,6 +165,7 @@ openedModule o = case o of
|
||||
OSimple _ m -> m
|
||||
OQualif _ _ m -> m
|
||||
|
||||
allOpens :: Module i f a -> [OpenSpec i]
|
||||
allOpens m = case mtype m of
|
||||
MTTransfer a b -> a : b : opens m
|
||||
_ -> opens m
|
||||
@@ -245,6 +249,7 @@ data IdentM i = IdentM {
|
||||
}
|
||||
deriving (Eq,Show)
|
||||
|
||||
typeOfModule :: ModInfo i f a -> ModuleType i
|
||||
typeOfModule mi = case mi of
|
||||
ModMod m -> mtype m
|
||||
|
||||
@@ -295,11 +300,13 @@ lookupInfo mo i = lookupTree show i (jments mo)
|
||||
allModMod :: (Show i,Eq i) => MGrammar i f a -> [(i,Module i f a)]
|
||||
allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
|
||||
|
||||
isModAbs :: Module i f a -> Bool
|
||||
isModAbs m = case mtype m of
|
||||
MTAbstract -> True
|
||||
---- MTUnion t -> isModAbs t
|
||||
_ -> False
|
||||
|
||||
isModRes :: Module i f a -> Bool
|
||||
isModRes m = case mtype m of
|
||||
MTResource -> True
|
||||
MTReuse _ -> True
|
||||
@@ -308,16 +315,19 @@ isModRes m = case mtype m of
|
||||
MTInstance _ -> True
|
||||
_ -> False
|
||||
|
||||
isModCnc :: Module i f a -> Bool
|
||||
isModCnc m = case mtype m of
|
||||
MTConcrete _ -> True
|
||||
---- MTUnion t -> isModCnc t
|
||||
_ -> False
|
||||
|
||||
isModTrans :: Module i f a -> Bool
|
||||
isModTrans m = case mtype m of
|
||||
MTTransfer _ _ -> True
|
||||
---- MTUnion t -> isModTrans t
|
||||
_ -> False
|
||||
|
||||
sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool
|
||||
sameMType m n = case (m,n) of
|
||||
(MTConcrete _, MTConcrete _) -> True
|
||||
(MTInstance _, MTInstance _) -> True
|
||||
@@ -329,6 +339,7 @@ sameMType m n = case (m,n) of
|
||||
_ -> m == n
|
||||
|
||||
-- | don't generate code for interfaces and for incomplete modules
|
||||
isCompilableModule :: ModInfo i f a -> Bool
|
||||
isCompilableModule m = case m of
|
||||
ModMod m -> case mtype m of
|
||||
MTInterface -> False
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Date: 2005/02/24 11:46:35 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
-- > CVS $Revision: 1.20 $
|
||||
--
|
||||
-- Options and flags used in GF shell commands and files.
|
||||
--
|
||||
@@ -18,60 +18,12 @@
|
||||
-- - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Option (-- * all kinds of options, should be kept abstract
|
||||
Option(..), Options(..), OptFun, OptFunId,
|
||||
noOptions, iOpt, aOpt, iOpts, oArg, oElem, eqOpt,
|
||||
getOptVal, getOptInt, optIntOrAll, optIntOrN, optIntOrOne,
|
||||
changeOptVal, addOption, addOptions, concatOptions,
|
||||
removeOption, removeOptions, options, unionOptions,
|
||||
|
||||
-- * parsing options, with prefix pre (e.g. \"-\")
|
||||
getOptions, pOption, isOption,
|
||||
|
||||
-- * printing options, without prefix
|
||||
prOpt, prOpts,
|
||||
|
||||
-- * a suggestion for option names
|
||||
-- ** parsing
|
||||
strictParse, forgiveParse, ignoreParse, literalParse,
|
||||
rawParse, firstParse, dontParse,
|
||||
-- ** grammar formats
|
||||
showAbstr, showXML, showOld, showLatex, showFullForm,
|
||||
showEBNF, showCF, showWords, showOpts,
|
||||
isCompiled, isHaskell, noCompOpers, retainOpers, defaultGrOpts,
|
||||
newParser, noCF, checkCirc, noCheckCirc, lexerByNeed,
|
||||
-- ** linearization
|
||||
allLin, firstLin, distinctLin, dontLin, showRecord, showStruct,
|
||||
xmlLin, latexLin, tableLin, defaultLinOpts, useUTF8, showLang, withMetas,
|
||||
-- ** other
|
||||
beVerbose, showInfo, beSilent, emitCode, getHelp, doMake, doBatch,
|
||||
notEmitCode, makeMulti, beShort, wholeGrammar, makeFudget, byLines, byWords,
|
||||
analMorpho, doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
|
||||
stripQualif, nostripQualif, showAll, fromSource,
|
||||
-- ** mainly for stand-alone
|
||||
useUnicode, optCompute, optCheck, optParaphrase, forJava,
|
||||
-- ** for edit session
|
||||
allLangs, absView,
|
||||
-- ** options that take arguments
|
||||
useTokenizer, useUntokenizer, useParser, withFun, firstCat, gStartCat,
|
||||
useLanguage, useResource, speechLanguage, useFont,
|
||||
grammarFormat, grammarPrinter, filterString, termCommand, transferFun,
|
||||
forForms, menuDisplay, sizeDisplay, typeDisplay,
|
||||
noDepTypes, extractGr, pathList, uniCoding,
|
||||
useName, useAbsName, useCncName, useResName, useFile, useOptimizer,
|
||||
markLin, markOptXML, markOptJava, markOptStruct, markOptFocus,
|
||||
-- ** refinement order
|
||||
nextRefine, firstRefine, lastRefine,
|
||||
-- ** Boolean flags
|
||||
flagYes, flagNo, caseYesNo,
|
||||
-- ** integer flags
|
||||
flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees
|
||||
) where
|
||||
module Option where
|
||||
|
||||
import List (partition)
|
||||
import Char (isDigit)
|
||||
|
||||
-- all kinds of options, to be kept abstract
|
||||
-- * all kinds of options, to be kept abstract
|
||||
|
||||
newtype Option = Opt (String,[String]) deriving (Eq,Show,Read)
|
||||
newtype Options = Opts [Option] deriving (Eq,Show,Read)
|
||||
@@ -79,20 +31,20 @@ newtype Options = Opts [Option] deriving (Eq,Show,Read)
|
||||
noOptions :: Options
|
||||
noOptions = Opts []
|
||||
|
||||
-- | simple option -o
|
||||
iOpt :: String -> Option
|
||||
iOpt o = Opt (o,[])
|
||||
-- ^ simple option -o
|
||||
|
||||
-- | option with argument -o=a
|
||||
aOpt :: String -> String -> Option
|
||||
aOpt o a = Opt (o,[a])
|
||||
-- ^ option with argument -o=a
|
||||
|
||||
iOpts :: [Option] -> Options
|
||||
iOpts = Opts
|
||||
|
||||
-- | value of option argument
|
||||
oArg :: String -> String
|
||||
oArg s = s
|
||||
-- ^ value of option argument
|
||||
|
||||
oElem :: Option -> Options -> Bool
|
||||
oElem o (Opts os) = elem o os
|
||||
@@ -135,6 +87,7 @@ changeOptVal os f x =
|
||||
addOption :: Option -> Options -> Options
|
||||
addOption o (Opts os) = iOpts (o:os)
|
||||
|
||||
addOptions :: Options -> Options -> Options
|
||||
addOptions (Opts os) os0 = foldr addOption os0 os
|
||||
|
||||
concatOptions :: [Options] -> Options
|
||||
@@ -143,14 +96,16 @@ concatOptions = foldr addOptions noOptions
|
||||
removeOption :: Option -> Options -> Options
|
||||
removeOption o (Opts os) = iOpts (filter (/=o) os)
|
||||
|
||||
removeOptions :: Options -> Options -> Options
|
||||
removeOptions (Opts os) os0 = foldr removeOption os0 os
|
||||
|
||||
options :: [Option] -> Options
|
||||
options = foldr addOption noOptions
|
||||
|
||||
unionOptions :: Options -> Options -> Options
|
||||
unionOptions (Opts os) (Opts os') = Opts (os ++ os')
|
||||
|
||||
-- parsing options, with prefix pre (e.g. "-")
|
||||
-- * parsing options, with prefix pre (e.g. \"-\")
|
||||
|
||||
getOptions :: String -> [String] -> (Options, [String])
|
||||
getOptions pre inp = let
|
||||
@@ -166,24 +121,39 @@ pOption pre s = case span (/= '=') (drop (length pre) s) of
|
||||
isOption :: String -> String -> Bool
|
||||
isOption pre = (==pre) . take (length pre)
|
||||
|
||||
-- printing options, without prefix
|
||||
-- * printing options, without prefix
|
||||
|
||||
prOpt :: Option -> String
|
||||
prOpt (Opt (s,[])) = s
|
||||
prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
|
||||
|
||||
prOpts :: Options -> String
|
||||
prOpts (Opts os) = unwords $ map prOpt os
|
||||
|
||||
-- a suggestion for option names
|
||||
-- * a suggestion for option names
|
||||
|
||||
-- ** parsing
|
||||
|
||||
strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
|
||||
-- | parse as term instead of string
|
||||
dontParse :: Option
|
||||
|
||||
-- parsing
|
||||
strictParse = iOpt "strict"
|
||||
forgiveParse = iOpt "n"
|
||||
ignoreParse = iOpt "ign"
|
||||
literalParse = iOpt "lit"
|
||||
rawParse = iOpt "raw"
|
||||
firstParse = iOpt "1"
|
||||
dontParse = iOpt "read" -- parse as term instead of string
|
||||
dontParse = iOpt "read"
|
||||
|
||||
-- ** grammar formats
|
||||
|
||||
showAbstr, showXML, showOld, showLatex, showFullForm,
|
||||
showEBNF, showCF, showWords, showOpts,
|
||||
isCompiled, isHaskell, noCompOpers, retainOpers,
|
||||
newParser, noCF, checkCirc, noCheckCirc, lexerByNeed :: Option
|
||||
defaultGrOpts :: [Option]
|
||||
|
||||
-- grammar formats
|
||||
showAbstr = iOpt "abs"
|
||||
showXML = iOpt "xml"
|
||||
showOld = iOpt "old"
|
||||
@@ -205,7 +175,13 @@ checkCirc = iOpt "nocirc"
|
||||
noCheckCirc = iOpt "nocheckcirc"
|
||||
lexerByNeed = iOpt "cflexer"
|
||||
|
||||
-- linearization
|
||||
-- ** linearization
|
||||
|
||||
allLin, firstLin, distinctLin, dontLin,
|
||||
showRecord, showStruct, xmlLin, latexLin,
|
||||
tableLin, useUTF8, showLang, withMetas :: Option
|
||||
defaultLinOpts :: [Option]
|
||||
|
||||
allLin = iOpt "all"
|
||||
firstLin = iOpt "one"
|
||||
distinctLin = iOpt "nub"
|
||||
@@ -220,7 +196,14 @@ useUTF8 = iOpt "utf8"
|
||||
showLang = iOpt "lang"
|
||||
withMetas = iOpt "metas"
|
||||
|
||||
-- other
|
||||
-- ** other
|
||||
|
||||
beVerbose, showInfo, beSilent, emitCode, getHelp,
|
||||
doMake, doBatch, notEmitCode, makeMulti, beShort,
|
||||
wholeGrammar, makeFudget, byLines, byWords, analMorpho,
|
||||
doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
|
||||
stripQualif, nostripQualif, showAll, fromSource :: Option
|
||||
|
||||
beVerbose = iOpt "v"
|
||||
showInfo = iOpt "i"
|
||||
beSilent = iOpt "s"
|
||||
@@ -246,24 +229,41 @@ nostripQualif = iOpt "nostrip"
|
||||
showAll = iOpt "all"
|
||||
fromSource = iOpt "src"
|
||||
|
||||
-- mainly for stand-alone
|
||||
-- ** mainly for stand-alone
|
||||
|
||||
useUnicode, optCompute, optCheck, optParaphrase, forJava :: Option
|
||||
|
||||
useUnicode = iOpt "unicode"
|
||||
optCompute = iOpt "compute"
|
||||
optCheck = iOpt "typecheck"
|
||||
optParaphrase = iOpt "paraphrase"
|
||||
forJava = iOpt "java"
|
||||
|
||||
-- for edit session
|
||||
-- ** for edit session
|
||||
|
||||
allLangs, absView :: Option
|
||||
|
||||
allLangs = iOpt "All"
|
||||
absView = iOpt "Abs"
|
||||
|
||||
-- options that take arguments
|
||||
-- ** options that take arguments
|
||||
|
||||
useTokenizer, useUntokenizer, useParser, withFun,
|
||||
useLanguage, useResource, speechLanguage, useFont,
|
||||
grammarFormat, grammarPrinter, filterString, termCommand,
|
||||
transferFun, forForms, menuDisplay, sizeDisplay, typeDisplay,
|
||||
noDepTypes, extractGr, pathList, uniCoding :: String -> Option
|
||||
-- | used on command line
|
||||
firstCat :: String -> Option
|
||||
-- | used in grammar, to avoid clash w res word
|
||||
gStartCat :: String -> Option
|
||||
|
||||
useTokenizer = aOpt "lexer"
|
||||
useUntokenizer = aOpt "unlexer"
|
||||
useParser = aOpt "parser"
|
||||
withFun = aOpt "fun"
|
||||
firstCat = aOpt "cat" -- used on command line
|
||||
gStartCat = aOpt "startcat" -- used in grammar, to avoid clash w res word
|
||||
firstCat = aOpt "cat"
|
||||
gStartCat = aOpt "startcat"
|
||||
useLanguage = aOpt "lang"
|
||||
useResource = aOpt "res"
|
||||
speechLanguage = aOpt "language"
|
||||
@@ -282,6 +282,9 @@ extractGr = aOpt "extract"
|
||||
pathList = aOpt "path"
|
||||
uniCoding = aOpt "coding"
|
||||
|
||||
useName, useAbsName, useCncName, useResName,
|
||||
useFile, useOptimizer :: String -> Option
|
||||
|
||||
useName = aOpt "name"
|
||||
useAbsName = aOpt "abs"
|
||||
useCncName = aOpt "cnc"
|
||||
@@ -289,6 +292,9 @@ useResName = aOpt "res"
|
||||
useFile = aOpt "file"
|
||||
useOptimizer = aOpt "optimize"
|
||||
|
||||
markLin :: String -> Option
|
||||
markOptXML, markOptJava, markOptStruct, markOptFocus :: String
|
||||
|
||||
markLin = aOpt "mark"
|
||||
markOptXML = oArg "xml"
|
||||
markOptJava = oArg "java"
|
||||
@@ -296,16 +302,26 @@ markOptStruct = oArg "struct"
|
||||
markOptFocus = oArg "focus"
|
||||
|
||||
|
||||
-- refinement order
|
||||
-- ** refinement order
|
||||
|
||||
nextRefine :: String -> Option
|
||||
firstRefine, lastRefine :: String
|
||||
|
||||
nextRefine = aOpt "nextrefine"
|
||||
firstRefine = oArg "first"
|
||||
lastRefine = oArg "last"
|
||||
|
||||
-- Boolean flags
|
||||
-- ** Boolean flags
|
||||
|
||||
flagYes, flagNo :: String
|
||||
|
||||
flagYes = oArg "yes"
|
||||
flagNo = oArg "no"
|
||||
|
||||
-- integer flags
|
||||
-- ** integer flags
|
||||
|
||||
flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
|
||||
|
||||
flagDepth = aOpt "depth"
|
||||
flagAlts = aOpt "alts"
|
||||
flagLength = aOpt "length"
|
||||
|
||||
@@ -5,56 +5,14 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Date: 2005/02/24 11:46:36 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
-- > CVS $Revision: 1.9 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module UseIO (prOptCPU,
|
||||
putCPU,
|
||||
putPoint,
|
||||
putPoint',
|
||||
readFileIf,
|
||||
FileName,
|
||||
InitPath,
|
||||
FullPath,
|
||||
getFilePath,
|
||||
readFileIfPath,
|
||||
doesFileExistPath,
|
||||
extendPathEnv,
|
||||
pFilePaths,
|
||||
prefixPathName,
|
||||
justInitPath,
|
||||
nameAndSuffix,
|
||||
unsuffixFile, fileBody,
|
||||
fileSuffix,
|
||||
justFileName,
|
||||
suffixFile,
|
||||
justModuleName,
|
||||
getLineWell,
|
||||
putStrFlush,
|
||||
putStrLnFlush,
|
||||
-- * a generic quiz session
|
||||
QuestionsAndAnswers,
|
||||
teachDialogue,
|
||||
-- * IO monad with error; adapted from state monad
|
||||
IOE(..),
|
||||
appIOE,
|
||||
ioe,
|
||||
ioeIO,
|
||||
ioeErr,
|
||||
ioeBad,
|
||||
useIOE,
|
||||
foldIOE,
|
||||
putStrLnE,
|
||||
putStrE,
|
||||
putPointE,
|
||||
putPointEVerb,
|
||||
readFileIOE,
|
||||
readFileLibraryIOE
|
||||
) where
|
||||
module UseIO where
|
||||
|
||||
import Operations
|
||||
import Arch (prCPU)
|
||||
@@ -67,11 +25,13 @@ import Monad
|
||||
putShow' :: Show a => (c -> a) -> c -> IO ()
|
||||
putShow' f = putStrLn . show . length . show . f
|
||||
|
||||
putIfVerb :: Options -> String -> IO ()
|
||||
putIfVerb opts msg =
|
||||
if oElem beVerbose opts
|
||||
then putStrLn msg
|
||||
else return ()
|
||||
|
||||
putIfVerbW :: Options -> String -> IO ()
|
||||
putIfVerbW opts msg =
|
||||
if oElem beVerbose opts
|
||||
then putStr (' ' : msg)
|
||||
@@ -88,8 +48,10 @@ errOptIO os e m = case m of
|
||||
putIfVerb os k
|
||||
return e
|
||||
|
||||
prOptCPU :: Options -> Integer -> IO Integer
|
||||
prOptCPU opts = if (oElem noCPU opts) then (const (return 0)) else prCPU
|
||||
|
||||
putCPU :: IO ()
|
||||
putCPU = do
|
||||
prCPU 0
|
||||
return ()
|
||||
@@ -194,7 +156,7 @@ putStrFlush s = putStr s >> hFlush stdout
|
||||
putStrLnFlush :: String -> IO ()
|
||||
putStrLnFlush s = putStrLn s >> hFlush stdout
|
||||
|
||||
-- a generic quiz session
|
||||
-- * a generic quiz session
|
||||
|
||||
type QuestionsAndAnswers = [(String, String -> (Integer,String))]
|
||||
|
||||
@@ -222,7 +184,7 @@ teachDialogue qas welc = do
|
||||
"You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
|
||||
|
||||
|
||||
-- IO monad with error; adapted from state monad
|
||||
-- * IO monad with error; adapted from state monad
|
||||
|
||||
newtype IOE a = IOE (IO (Err a))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user