Skip to content

Commit

Permalink
make "cc", "so", "create lin", "create lincat" usable even without lo…
Browse files Browse the repository at this point in the history
…aded grammar
  • Loading branch information
krangelov committed Nov 23, 2023
1 parent 511fdee commit e996d78
Show file tree
Hide file tree
Showing 3 changed files with 53 additions and 32 deletions.
52 changes: 27 additions & 25 deletions src/compiler/GF/Command/SourceCommands.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
-- | Commands requiring source grammar in env
module GF.Command.SourceCommands(HasGrammar(..),sourceCommands) where

import Prelude hiding (putStrLn)
import qualified Prelude as P(putStrLn)
import Data.List(nub,isInfixOf,isPrefixOf)
Expand All @@ -21,6 +22,7 @@ import GF.Grammar.Lookup (allOpers,allOpersTo)
import GF.Compile.Rename(renameSourceTerm)
import GF.Compile.Compute.Concrete(normalForm)
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.CommandInfo
Expand All @@ -37,8 +39,8 @@ sourceCommands = Map.fromList [
explanation = unlines [
"Compute TERM by concrete syntax definitions. Uses the topmost",
"module (the last one imported) to resolve constant names.",
"N.B.1 You need the flag -retain when importing the grammar, if you want",
"the definitions to be retained after compilation.",
"N.B.1 You need the flag -retain or -resource when importing the grammar,",
"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",
"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",
Expand Down Expand Up @@ -109,8 +111,9 @@ sourceCommands = Map.fromList [
synopsis = "show all operations in scope, possibly restricted to a value type",
explanation = unlines [
"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'.",
"The operations include the parameter constructors that are in scope.",
"If no grammar is loaded with 'import -retain' or 'import -resource',",
"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 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",
Expand Down Expand Up @@ -198,24 +201,22 @@ sourceCommands = Map.fromList [
| otherwise = unwords $ map prTerm ops
return $ fromString printed

show_operations os ts sgr = fmap fst $ runCheck $
case greatestResource sgr of
Nothing -> checkError (pp "no source grammar in scope; did you import with -retain?")
Just mo -> do
let greps = map valueString (listFlags "grep" os)
let isRaw = isOpt "raw" os
ops <- case ts of
_:_ -> do
let Right t = runP pExp (UTF8.fromString (unwords ts))
ty <- checkComputeTerm os sgr t
return $ allOpersTo sgr ty
_ -> return $ allOpers sgr
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
let printer = if isRaw
then showTerm sgr TermPrintDefault Qualified
else (render . TC.ppType)
let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
show_operations os ts sgr0 = fmap fst $ runCheck $ do
let (sgr,mo) = case greatestResource sgr0 of
Nothing -> (mGrammar [predefMod], fst predefMod)
Just mo -> (sgr0,mo)
greps = map valueString (listFlags "grep" os)
ops <- case ts of
_:_ -> do let Right t = runP pExp (UTF8.fromString (unwords ts))
ty <- checkComputeTerm os sgr t
return $ allOpersTo sgr ty
_ -> return $ allOpers sgr
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
printer = if isOpt "raw" os
then showTerm sgr TermPrintDefault Qualified
else (render . TC.ppType)
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
let strip = if isOpt "strip" os then stripSourceGrammar else id
Expand Down Expand Up @@ -251,9 +252,10 @@ sourceCommands = Map.fromList [
P.putStrLn "wrote graph in file _gfdepgraph.dot"
return void

checkComputeTerm os sgr t =
do mo <- maybe (checkError (pp "no source grammar in scope")) return $
greatestResource sgr
checkComputeTerm os sgr0 t =
do let (sgr,mo) = case greatestResource sgr0 of
Nothing -> (mGrammar [predefMod], fst predefMod)
Just mo -> (sgr0,mo)
t <- renameSourceTerm sgr mo t
(t,_) <- inferLType sgr [] t
fmap evalStr (normalForm sgr t)
Expand Down
18 changes: 17 additions & 1 deletion src/compiler/GF/Compile/TypeCheck/Primitives.hs
Original file line number Diff line number Diff line change
@@ -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.Predef
import qualified Data.Map as Map
Expand All @@ -11,6 +12,21 @@ typPredefined f = case Map.lookup f primitives of
Just (ResValue (L _ ty) _) -> Just ty
_ -> 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
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
, (cInt , ResOper (Just (noLoc typePType)) Nothing)
Expand Down
15 changes: 9 additions & 6 deletions src/compiler/GF/Interactive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ import GF.Command.Abstract
import GF.Command.Parse(readCommandLine,pCommand,readTransactionCommand)
import GF.Compile.Rename(renameSourceTerm)
import GF.Compile.TypeCheck.Concrete(inferLType)
import GF.Compile.TypeCheck.Primitives(predefMod)
import GF.Compile.GeneratePMCFG(pmcfgForm,type2fields)
import GF.Data.Operations (Err(..))
import GF.Data.Utilities(whenM,repeatM)
Expand Down Expand Up @@ -283,10 +284,11 @@ transactionCommand (CreateConcrete opts name) pgf mb_txnid = do
lift $ updatePGF pgf mb_txnid (createConcrete name (return ()))
return ()
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
mo <- maybe (fail "no source grammar in scope") return $
greatestResource sgr
lift $ updatePGF pgf mb_txnid $ do
mb_ty <- getFunctionType f
case mb_ty of
Expand Down Expand Up @@ -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)))

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
mo <- maybe (fail "no source grammar in scope") return $
greatestResource sgr
case runCheck (compileLincatTerm sgr mo t) of
Ok (fields,_)-> do lift $ updatePGF pgf mb_txnid (alterConcrete lang (createLincat c fields [] [] Seq.empty >> return ()))
return ()
Expand Down

0 comments on commit e996d78

Please sign in to comment.