mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 11:19:32 -06:00
Founding the newly structured GF2.0 cvs archive.
This commit is contained in:
aarne
256
src/GF/UseGrammar/Custom.hs
Normal file
256
src/GF/UseGrammar/Custom.hs
Normal file
@@ -0,0 +1,256 @@
|
||||
module Custom where
|
||||
|
||||
import Operations
|
||||
import Text
|
||||
import Tokenize
|
||||
import qualified Grammar as G
|
||||
import qualified AbsGFC as A
|
||||
import qualified GFC as C
|
||||
import qualified AbsGF as GF
|
||||
import qualified MMacros as MM
|
||||
import AbsCompute
|
||||
import TypeCheck
|
||||
------import Compile
|
||||
import ShellState
|
||||
import Editing
|
||||
import Paraphrases
|
||||
import Option
|
||||
import CF
|
||||
import CFIdent
|
||||
|
||||
---- import CFtoGrammar
|
||||
import PPrCF
|
||||
import PrGrammar
|
||||
|
||||
----import Morphology
|
||||
-----import GrammarToHaskell
|
||||
-----import GrammarToCanon (showCanon, showCanonOpt)
|
||||
-----import qualified GrammarToGFC as GFC
|
||||
|
||||
-- the cf parsing algorithms
|
||||
import ChartParser -- or some other CF Parser
|
||||
|
||||
import MoreCustom -- either small/ or big/. The one in Small is empty.
|
||||
|
||||
import UseIO
|
||||
|
||||
-- minimal version also used in Hugs. AR 2/12/2002.
|
||||
|
||||
-- databases for customizable commands. AR 21/11/2001
|
||||
-- for: grammar parsers, grammar printers, term commands, string commands
|
||||
-- idea: items added here are usable throughout GF; nothing else need be edited
|
||||
-- they are often usable through the API: hence API cannot be imported here!
|
||||
|
||||
-- Major redesign 3/4/2002: the first entry in each database is DEFAULT.
|
||||
-- If no other value is given, the default is selected.
|
||||
-- Because of this, two invariants have to be preserved:
|
||||
-- ** no databases may be empty
|
||||
-- ** additions are made to the end of the database
|
||||
|
||||
-- these are the databases; the comment gives the name of the flag
|
||||
|
||||
-- grammarFormat, "-format=x" or file suffix
|
||||
customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar)
|
||||
|
||||
-- grammarPrinter, "-printer=x"
|
||||
customGrammarPrinter :: CustomData (StateGrammar -> String)
|
||||
|
||||
-- syntaxPrinter, "-printer=x"
|
||||
customSyntaxPrinter :: CustomData (GF.Grammar -> String)
|
||||
|
||||
-- termPrinter, "-printer=x"
|
||||
customTermPrinter :: CustomData (StateGrammar -> A.Exp -> String)
|
||||
|
||||
-- termCommand, "-transform=x"
|
||||
customTermCommand :: CustomData (StateGrammar -> A.Exp -> [A.Exp])
|
||||
|
||||
-- editCommand, "-edit=x"
|
||||
customEditCommand :: CustomData (StateGrammar -> Action)
|
||||
|
||||
-- filterString, "-filter=x"
|
||||
customStringCommand :: CustomData (StateGrammar -> String -> String)
|
||||
|
||||
-- useParser, "-parser=x"
|
||||
customParser :: CustomData (StateGrammar -> CFCat -> CFParser)
|
||||
|
||||
-- useTokenizer, "-lexer=x"
|
||||
customTokenizer :: CustomData (StateGrammar -> String -> [CFTok])
|
||||
|
||||
-- useUntokenizer, "-unlexer=x" --- should be from token list to string
|
||||
customUntokenizer :: CustomData (StateGrammar -> String -> String)
|
||||
|
||||
|
||||
-- this is the way of selecting an item
|
||||
customOrDefault :: Options -> OptFun -> CustomData a -> a
|
||||
customOrDefault opts optfun db = maybe (defaultCustomVal db) id $
|
||||
customAsOptVal opts optfun db
|
||||
|
||||
-- to produce menus of custom operations
|
||||
customInfo :: CustomData a -> (String, [String])
|
||||
customInfo c = (titleCustomData c, map (ciStr . fst) (dbCustomData c))
|
||||
|
||||
-------------------------------
|
||||
|
||||
type CommandId = String
|
||||
|
||||
strCI :: String -> CommandId
|
||||
strCI = id
|
||||
|
||||
ciStr :: CommandId -> String
|
||||
ciStr = id
|
||||
|
||||
ciOpt :: CommandId -> Option
|
||||
ciOpt = iOpt
|
||||
|
||||
newtype CustomData a = CustomData (String, [(CommandId,a)])
|
||||
customData title db = CustomData (title,db)
|
||||
dbCustomData (CustomData (_,db)) = db
|
||||
titleCustomData (CustomData (t,_)) = t
|
||||
|
||||
lookupCustom :: CustomData a -> CommandId -> Maybe a
|
||||
lookupCustom = flip lookup . dbCustomData
|
||||
|
||||
customAsOptVal :: Options -> OptFun -> CustomData a -> Maybe a
|
||||
customAsOptVal opts optfun db = do
|
||||
arg <- getOptVal opts optfun
|
||||
lookupCustom db (strCI arg)
|
||||
|
||||
-- take the first entry from the database
|
||||
defaultCustomVal :: CustomData a -> a
|
||||
defaultCustomVal (CustomData (s,db)) =
|
||||
ifNull (error ("empty database:" +++ s)) (snd . head) db
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- and here's the customizable part:
|
||||
|
||||
-- grammar parsers: the ID is also used as file name suffix
|
||||
customGrammarParser =
|
||||
customData "Grammar parsers, selected by file name suffix" $
|
||||
[
|
||||
------ (strCI "gf", compileModule noOptions) -- DEFAULT
|
||||
-- add your own grammar parsers here
|
||||
]
|
||||
++ moreCustomGrammarParser
|
||||
|
||||
|
||||
customGrammarPrinter =
|
||||
customData "Grammar printers, selected by option -printer=x" $
|
||||
[
|
||||
---- (strCI "gf", prt) -- DEFAULT
|
||||
(strCI "cf", prCF . stateCF)
|
||||
|
||||
{- ----
|
||||
(strCI "gf", prt . st2grammar . stateGrammarST) -- DEFAULT
|
||||
,(strCI "canon", showCanon "Lang" . stateGrammarST)
|
||||
,(strCI "gfc", GFC.showGFC . stateGrammarST)
|
||||
,(strCI "canonOpt",showCanonOpt "Lang" . stateGrammarST)
|
||||
,(strCI "morpho", prMorpho . stateMorpho)
|
||||
,(strCI "opts", prOpts . stateOptions)
|
||||
-}
|
||||
-- add your own grammar printers here
|
||||
--- also include printing via grammar2syntax!
|
||||
]
|
||||
++ moreCustomGrammarPrinter
|
||||
|
||||
customSyntaxPrinter =
|
||||
customData "Syntax printers, selected by option -printer=x" $
|
||||
[
|
||||
-- add your own grammar printers here
|
||||
]
|
||||
++ moreCustomSyntaxPrinter
|
||||
|
||||
|
||||
customTermPrinter =
|
||||
customData "Term printers, selected by option -printer=x" $
|
||||
[
|
||||
(strCI "gf", const prt) -- DEFAULT
|
||||
-- add your own term printers here
|
||||
]
|
||||
++ moreCustomTermPrinter
|
||||
|
||||
customTermCommand =
|
||||
customData "Term transformers, selected by option -transform=x" $
|
||||
[
|
||||
(strCI "identity", \_ t -> [t]) -- DEFAULT
|
||||
{- ----
|
||||
,(strCI "compute", \g t -> err (const [t]) return (computeAbsTerm g t))
|
||||
,(strCI "paraphrase", \g t -> mkParaphrases g t)
|
||||
,(strCI "typecheck", \g t -> err (const []) return (checkIfValidExp g t))
|
||||
,(strCI "solve", \g t -> editAsTermCommand g
|
||||
(uniqueRefinements g) t)
|
||||
,(strCI "context", \g t -> editAsTermCommand g
|
||||
(contextRefinements g) t)
|
||||
-}
|
||||
--- ,(strCI "delete", \g t -> [MM.mExp0])
|
||||
-- add your own term commands here
|
||||
]
|
||||
++ moreCustomTermCommand
|
||||
|
||||
customEditCommand =
|
||||
customData "Editor state transformers, selected by option -edit=x" $
|
||||
[
|
||||
(strCI "identity", const return) -- DEFAULT
|
||||
,(strCI "transfer", const return) --- done ad hoc on top level
|
||||
{- ----
|
||||
,(strCI "typecheck", reCheckState)
|
||||
,(strCI "solve", solveAll)
|
||||
,(strCI "context", contextRefinements)
|
||||
,(strCI "compute", computeSubTree)
|
||||
-}
|
||||
,(strCI "paraphrase", const return) --- done ad hoc on top level
|
||||
-- add your own edit commands here
|
||||
]
|
||||
++ moreCustomEditCommand
|
||||
|
||||
customStringCommand =
|
||||
customData "String filters, selected by option -filter=x" $
|
||||
[
|
||||
(strCI "identity", const $ id) -- DEFAULT
|
||||
,(strCI "erase", const $ const "")
|
||||
,(strCI "take100", const $ take 100)
|
||||
,(strCI "text", const $ formatAsText)
|
||||
,(strCI "code", const $ formatAsCode)
|
||||
---- ,(strCI "latexfile", const $ mkLatexFile)
|
||||
,(strCI "length", const $ show . length)
|
||||
-- add your own string commands here
|
||||
]
|
||||
++ moreCustomStringCommand
|
||||
|
||||
customParser =
|
||||
customData "Parsers, selected by option -parser=x" $
|
||||
[
|
||||
(strCI "chart", chartParser . stateCF)
|
||||
-- add your own parsers here
|
||||
]
|
||||
++ moreCustomParser
|
||||
|
||||
customTokenizer =
|
||||
customData "Tokenizers, selected by option -lexer=x" $
|
||||
[
|
||||
(strCI "words", const $ tokWords)
|
||||
,(strCI "literals", const $ tokLits)
|
||||
,(strCI "vars", const $ tokVars)
|
||||
,(strCI "chars", const $ map (tS . singleton))
|
||||
,(strCI "code", const $ lexHaskell)
|
||||
,(strCI "text", const $ lexText)
|
||||
---- ,(strCI "codelit", lexHaskellLiteral . stateIsWord)
|
||||
---- ,(strCI "textlit", lexTextLiteral . stateIsWord)
|
||||
,(strCI "codeC", const $ lexC2M)
|
||||
,(strCI "codeCHigh", const $ lexC2M' True)
|
||||
-- add your own tokenizers here
|
||||
]
|
||||
++ moreCustomTokenizer
|
||||
|
||||
customUntokenizer =
|
||||
customData "Untokenizers, selected by option -unlexer=x" $
|
||||
[
|
||||
(strCI "unwords", const $ id) -- DEFAULT
|
||||
,(strCI "text", const $ formatAsText)
|
||||
,(strCI "code", const $ formatAsCode)
|
||||
,(strCI "textlit", const $ formatAsTextLit)
|
||||
,(strCI "codelit", const $ formatAsCodeLit)
|
||||
,(strCI "concat", const $ concat . words)
|
||||
,(strCI "bind", const $ performBinds)
|
||||
-- add your own untokenizers here
|
||||
]
|
||||
++ moreCustomUntokenizer
|
||||
Reference in New Issue
Block a user