mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-22 09:32:53 -06:00
make "cc", "so", "create lin", "create lincat" usable even without loaded grammar
This commit is contained in:
@@ -1,5 +1,6 @@
|
|||||||
-- | Commands requiring source grammar in env
|
-- | Commands requiring source grammar in env
|
||||||
module GF.Command.SourceCommands(HasGrammar(..),sourceCommands) where
|
module GF.Command.SourceCommands(HasGrammar(..),sourceCommands) where
|
||||||
|
|
||||||
import Prelude hiding (putStrLn)
|
import Prelude hiding (putStrLn)
|
||||||
import qualified Prelude as P(putStrLn)
|
import qualified Prelude as P(putStrLn)
|
||||||
import Data.List(nub,isInfixOf,isPrefixOf)
|
import Data.List(nub,isInfixOf,isPrefixOf)
|
||||||
@@ -21,6 +22,7 @@ import GF.Grammar.Lookup (allOpers,allOpersTo)
|
|||||||
import GF.Compile.Rename(renameSourceTerm)
|
import GF.Compile.Rename(renameSourceTerm)
|
||||||
import GF.Compile.Compute.Concrete(normalForm)
|
import GF.Compile.Compute.Concrete(normalForm)
|
||||||
import GF.Compile.TypeCheck.Concrete as TC(inferLType,ppType)
|
import GF.Compile.TypeCheck.Concrete as TC(inferLType,ppType)
|
||||||
|
import GF.Compile.TypeCheck.Primitives(predefMod)
|
||||||
|
|
||||||
import GF.Command.Abstract(Option(..),isOpt,listFlags,valueString,valStrOpts)
|
import GF.Command.Abstract(Option(..),isOpt,listFlags,valueString,valStrOpts)
|
||||||
import GF.Command.CommandInfo
|
import GF.Command.CommandInfo
|
||||||
@@ -37,8 +39,8 @@ sourceCommands = Map.fromList [
|
|||||||
explanation = unlines [
|
explanation = unlines [
|
||||||
"Compute TERM by concrete syntax definitions. Uses the topmost",
|
"Compute TERM by concrete syntax definitions. Uses the topmost",
|
||||||
"module (the last one imported) to resolve constant names.",
|
"module (the last one imported) to resolve constant names.",
|
||||||
"N.B.1 You need the flag -retain when importing the grammar, if you want",
|
"N.B.1 You need the flag -retain or -resource when importing the grammar,",
|
||||||
"the definitions to be retained after compilation.",
|
"if you want the definitions to be available after compilation.",
|
||||||
"N.B.2 The resulting term is not a tree in the sense of abstract syntax",
|
"N.B.2 The resulting term is not a tree in the sense of abstract syntax",
|
||||||
"and hence not a valid input to a Tree-expecting command.",
|
"and hence not a valid input to a Tree-expecting command.",
|
||||||
"This command must be a line of its own, and thus cannot be a part",
|
"This command must be a line of its own, and thus cannot be a part",
|
||||||
@@ -109,8 +111,9 @@ sourceCommands = Map.fromList [
|
|||||||
synopsis = "show all operations in scope, possibly restricted to a value type",
|
synopsis = "show all operations in scope, possibly restricted to a value type",
|
||||||
explanation = unlines [
|
explanation = unlines [
|
||||||
"Show the names and type signatures of all operations available in the current resource.",
|
"Show the names and type signatures of all operations available in the current resource.",
|
||||||
"This command requires a source grammar to be in scope, imported with 'import -retain'.",
|
"If no grammar is loaded with 'import -retain' or 'import -resource',",
|
||||||
"The operations include the parameter constructors that are in scope.",
|
"then only the predefined operations are in scope.",
|
||||||
|
"The operations include also the parameter constructors that are in scope.",
|
||||||
"The optional TYPE filters according to the value type.",
|
"The optional TYPE filters according to the value type.",
|
||||||
"The grep STRINGs filter according to other substrings of the type signatures."{-,
|
"The grep STRINGs filter according to other substrings of the type signatures."{-,
|
||||||
"This command must be a line of its own, and thus cannot be a part",
|
"This command must be a line of its own, and thus cannot be a part",
|
||||||
@@ -198,23 +201,21 @@ sourceCommands = Map.fromList [
|
|||||||
| otherwise = unwords $ map prTerm ops
|
| otherwise = unwords $ map prTerm ops
|
||||||
return $ fromString printed
|
return $ fromString printed
|
||||||
|
|
||||||
show_operations os ts sgr = fmap fst $ runCheck $
|
show_operations os ts sgr0 = fmap fst $ runCheck $ do
|
||||||
case greatestResource sgr of
|
let (sgr,mo) = case greatestResource sgr0 of
|
||||||
Nothing -> checkError (pp "no source grammar in scope; did you import with -retain?")
|
Nothing -> (mGrammar [predefMod], fst predefMod)
|
||||||
Just mo -> do
|
Just mo -> (sgr0,mo)
|
||||||
let greps = map valueString (listFlags "grep" os)
|
greps = map valueString (listFlags "grep" os)
|
||||||
let isRaw = isOpt "raw" os
|
|
||||||
ops <- case ts of
|
ops <- case ts of
|
||||||
_:_ -> do
|
_:_ -> do let Right t = runP pExp (UTF8.fromString (unwords ts))
|
||||||
let Right t = runP pExp (UTF8.fromString (unwords ts))
|
|
||||||
ty <- checkComputeTerm os sgr t
|
ty <- checkComputeTerm os sgr t
|
||||||
return $ allOpersTo sgr ty
|
return $ allOpersTo sgr ty
|
||||||
_ -> return $ allOpers sgr
|
_ -> return $ allOpers sgr
|
||||||
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
|
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
|
||||||
let printer = if isRaw
|
printer = if isOpt "raw" os
|
||||||
then showTerm sgr TermPrintDefault Qualified
|
then showTerm sgr TermPrintDefault Qualified
|
||||||
else (render . TC.ppType)
|
else (render . TC.ppType)
|
||||||
let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
|
printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
|
||||||
return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
|
return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
|
||||||
|
|
||||||
show_source os ts sgr = do
|
show_source os ts sgr = do
|
||||||
@@ -251,9 +252,10 @@ sourceCommands = Map.fromList [
|
|||||||
P.putStrLn "wrote graph in file _gfdepgraph.dot"
|
P.putStrLn "wrote graph in file _gfdepgraph.dot"
|
||||||
return void
|
return void
|
||||||
|
|
||||||
checkComputeTerm os sgr t =
|
checkComputeTerm os sgr0 t =
|
||||||
do mo <- maybe (checkError (pp "no source grammar in scope")) return $
|
do let (sgr,mo) = case greatestResource sgr0 of
|
||||||
greatestResource sgr
|
Nothing -> (mGrammar [predefMod], fst predefMod)
|
||||||
|
Just mo -> (sgr0,mo)
|
||||||
t <- renameSourceTerm sgr mo t
|
t <- renameSourceTerm sgr mo t
|
||||||
(t,_) <- inferLType sgr [] t
|
(t,_) <- inferLType sgr [] t
|
||||||
fmap evalStr (normalForm sgr t)
|
fmap evalStr (normalForm sgr t)
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module GF.Compile.TypeCheck.Primitives where
|
module GF.Compile.TypeCheck.Primitives(typPredefined,predefMod) where
|
||||||
|
|
||||||
|
import GF.Infra.Option
|
||||||
import GF.Grammar
|
import GF.Grammar
|
||||||
import GF.Grammar.Predef
|
import GF.Grammar.Predef
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@@ -11,6 +12,21 @@ typPredefined f = case Map.lookup f primitives of
|
|||||||
Just (ResValue (L _ ty) _) -> Just ty
|
Just (ResValue (L _ ty) _) -> Just ty
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
predefMod = (cPredef, modInfo)
|
||||||
|
where
|
||||||
|
modInfo = ModInfo {
|
||||||
|
mtype = MTResource,
|
||||||
|
mstatus = MSComplete,
|
||||||
|
mflags = noOptions,
|
||||||
|
mextend = [],
|
||||||
|
mwith = Nothing,
|
||||||
|
mopens = [],
|
||||||
|
mexdeps = [],
|
||||||
|
msrc = "Predef.gfo",
|
||||||
|
mseqs = Nothing,
|
||||||
|
jments = primitives
|
||||||
|
}
|
||||||
|
|
||||||
primitives = Map.fromList
|
primitives = Map.fromList
|
||||||
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
|
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
|
||||||
, (cInt , ResOper (Just (noLoc typePType)) Nothing)
|
, (cInt , ResOper (Just (noLoc typePType)) Nothing)
|
||||||
|
|||||||
@@ -14,6 +14,7 @@ import GF.Command.Abstract
|
|||||||
import GF.Command.Parse(readCommandLine,pCommand,readTransactionCommand)
|
import GF.Command.Parse(readCommandLine,pCommand,readTransactionCommand)
|
||||||
import GF.Compile.Rename(renameSourceTerm)
|
import GF.Compile.Rename(renameSourceTerm)
|
||||||
import GF.Compile.TypeCheck.Concrete(inferLType)
|
import GF.Compile.TypeCheck.Concrete(inferLType)
|
||||||
|
import GF.Compile.TypeCheck.Primitives(predefMod)
|
||||||
import GF.Compile.GeneratePMCFG(pmcfgForm,type2fields)
|
import GF.Compile.GeneratePMCFG(pmcfgForm,type2fields)
|
||||||
import GF.Data.Operations (Err(..))
|
import GF.Data.Operations (Err(..))
|
||||||
import GF.Data.Utilities(whenM,repeatM)
|
import GF.Data.Utilities(whenM,repeatM)
|
||||||
@@ -283,10 +284,11 @@ transactionCommand (CreateConcrete opts name) pgf mb_txnid = do
|
|||||||
lift $ updatePGF pgf mb_txnid (createConcrete name (return ()))
|
lift $ updatePGF pgf mb_txnid (createConcrete name (return ()))
|
||||||
return ()
|
return ()
|
||||||
transactionCommand (CreateLin opts f t is_alter) pgf mb_txnid = do
|
transactionCommand (CreateLin opts f t is_alter) pgf mb_txnid = do
|
||||||
sgr <- getGrammar
|
sgr0 <- getGrammar
|
||||||
|
let (sgr,mo) = case greatestResource sgr0 of
|
||||||
|
Nothing -> (mGrammar [predefMod], fst predefMod)
|
||||||
|
Just mo -> (sgr0,mo)
|
||||||
lang <- optLang pgf opts
|
lang <- optLang pgf opts
|
||||||
mo <- maybe (fail "no source grammar in scope") return $
|
|
||||||
greatestResource sgr
|
|
||||||
lift $ updatePGF pgf mb_txnid $ do
|
lift $ updatePGF pgf mb_txnid $ do
|
||||||
mb_ty <- getFunctionType f
|
mb_ty <- getFunctionType f
|
||||||
case mb_ty of
|
case mb_ty of
|
||||||
@@ -319,10 +321,11 @@ transactionCommand (CreateLin opts f t is_alter) pgf mb_txnid = do
|
|||||||
mapToSequence m = Seq.fromList (map (Left . fst) (sortOn snd (Map.toList m)))
|
mapToSequence m = Seq.fromList (map (Left . fst) (sortOn snd (Map.toList m)))
|
||||||
|
|
||||||
transactionCommand (CreateLincat opts c t) pgf mb_txnid = do
|
transactionCommand (CreateLincat opts c t) pgf mb_txnid = do
|
||||||
sgr <- getGrammar
|
sgr0 <- getGrammar
|
||||||
|
let (sgr,mo) = case greatestResource sgr0 of
|
||||||
|
Nothing -> (mGrammar [predefMod], fst predefMod)
|
||||||
|
Just mo -> (sgr0,mo)
|
||||||
lang <- optLang pgf opts
|
lang <- optLang pgf opts
|
||||||
mo <- maybe (fail "no source grammar in scope") return $
|
|
||||||
greatestResource sgr
|
|
||||||
case runCheck (compileLincatTerm sgr mo t) of
|
case runCheck (compileLincatTerm sgr mo t) of
|
||||||
Ok (fields,_)-> do lift $ updatePGF pgf mb_txnid (alterConcrete lang (createLincat c fields [] [] Seq.empty >> return ()))
|
Ok (fields,_)-> do lift $ updatePGF pgf mb_txnid (alterConcrete lang (createLincat c fields [] [] Seq.empty >> return ()))
|
||||||
return ()
|
return ()
|
||||||
|
|||||||
Reference in New Issue
Block a user