make "cc", "so", "create lin", "create lincat" usable even without loaded grammar

This commit is contained in:
Krasimir Angelov
2023-11-23 20:26:48 +01:00
parent 511fdeee44
commit e996d78b18
3 changed files with 53 additions and 32 deletions

View File

@@ -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,24 +201,22 @@ 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 let Right t = runP pExp (UTF8.fromString (unwords ts))
_:_ -> do ty <- checkComputeTerm os sgr t
let Right t = runP pExp (UTF8.fromString (unwords ts)) return $ allOpersTo sgr ty
ty <- checkComputeTerm os sgr t _ -> return $ allOpers sgr
return $ allOpersTo sgr ty let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
_ -> return $ allOpers sgr printer = if isOpt "raw" os
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops] then showTerm sgr TermPrintDefault Qualified
let printer = if isRaw else (render . TC.ppType)
then showTerm sgr TermPrintDefault Qualified printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
else (render . TC.ppType) return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
show_source os ts sgr = do show_source os ts sgr = do
let strip = if isOpt "strip" os then stripSourceGrammar else id let strip = if isOpt "strip" os then stripSourceGrammar else id
@@ -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)

View File

@@ -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)

View File

@@ -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 ()