fix the parsing for source commands

This commit is contained in:
Krasimir Angelov
2024-02-08 13:38:45 +01:00
parent 9fd1c5da80
commit ab30f1f9e5
3 changed files with 17 additions and 25 deletions

View File

@@ -28,7 +28,7 @@ pCommand = (do
cmd <- pIdent <++ (char '%' >> fmap ('%':) pIdent) cmd <- pIdent <++ (char '%' >> fmap ('%':) pIdent)
skipSpaces skipSpaces
opts <- sepBy pOption skipSpaces opts <- sepBy pOption skipSpaces
arg <- if getCommandOp cmd == "cc" then pArgTerm else pArgument arg <- if getCommandOp cmd `elem` ["cc","sd","so"] then pArgTerm else pArgument
return (Command cmd opts arg) return (Command cmd opts arg)
) )
<++ (do <++ (do

View File

@@ -16,7 +16,6 @@ import GF.Data.Operations (chunks,err,raise)
import GF.Grammar hiding (Ident,isPrefixOf) import GF.Grammar hiding (Ident,isPrefixOf)
import GF.Grammar.Analyse import GF.Grammar.Analyse
import GF.Grammar.Parser (runP, pExp)
import GF.Grammar.ShowTerm import GF.Grammar.ShowTerm
import GF.Grammar.Lookup (allOpers,allOpersTo) import GF.Grammar.Lookup (allOpers,allOpersTo)
import GF.Compile.Rename(renameSourceTerm) import GF.Compile.Rename(renameSourceTerm)
@@ -54,7 +53,7 @@ sourceCommands = Map.fromList [
("trace","trace computations") ("trace","trace computations")
], ],
needsTypeCheck = False, -- why not True? needsTypeCheck = False, -- why not True?
exec = withStrings compute_concrete exec = withTerm compute_concrete
}), }),
("dg", emptyCommandInfo { ("dg", emptyCommandInfo {
longname = "dependency_graph", longname = "dependency_graph",
@@ -101,7 +100,7 @@ sourceCommands = Map.fromList [
mkEx "sd -size ParadigmsEng.mkV -- show all constants on which mkV depends, together with size" mkEx "sd -size ParadigmsEng.mkV -- show all constants on which mkV depends, together with size"
], ],
needsTypeCheck = False, needsTypeCheck = False,
exec = withStrings show_deps exec = withTerm show_deps
}), }),
("so", emptyCommandInfo { ("so", emptyCommandInfo {
@@ -130,7 +129,7 @@ sourceCommands = Map.fromList [
mkEx "so | wf -file=/tmp/opers -- write the list of opers to a file" mkEx "so | wf -file=/tmp/opers -- write the list of opers to a file"
], ],
needsTypeCheck = False, needsTypeCheck = False,
exec = withStrings show_operations exec = withTerm show_operations
}), }),
("ss", emptyCommandInfo { ("ss", emptyCommandInfo {
@@ -163,14 +162,15 @@ sourceCommands = Map.fromList [
do sgr <- getGrammar do sgr <- getGrammar
liftSIO (exec opts (toStrings ts) sgr) liftSIO (exec opts (toStrings ts) sgr)
compute_concrete opts ws sgr = fmap fst $ runCheck $ withTerm exec opts ts =
case runP pExp (UTF8.fromString s) of do sgr <- getGrammar
Left (_,msg) -> return $ pipeMessage msg liftSIO (exec opts (toTerm ts) sgr)
Right t -> do t <- checkComputeTerm opts sgr t
return (fromString (showTerm sgr style q t)) compute_concrete opts t sgr = fmap fst $ runCheck $ do
t <- checkComputeTerm opts sgr t
return (fromString (showTerm sgr style q t))
where where
(style,q) = pOpts TermPrintDefault Qualified opts (style,q) = pOpts TermPrintDefault Qualified opts
s = unwords ws
pOpts style q [] = (style,q) pOpts style q [] = (style,q)
pOpts style q (o:os) = pOpts style q (o:os) =
@@ -184,12 +184,8 @@ sourceCommands = Map.fromList [
OOpt "qual" -> pOpts style Qualified os OOpt "qual" -> pOpts style Qualified os
_ -> pOpts style q os _ -> pOpts style q os
show_deps os xs sgr = do show_deps os t sgr = do
ops <- case xs of ops <- err error (return . nub) $ constantDepsTerm sgr t
_:_ -> do
let ts = [t | Right t <- map (runP pExp . UTF8.fromString) xs]
err error (return . nub . concat) $ mapM (constantDepsTerm sgr) ts
_ -> error "expected one or more qualified constants as argument"
let prTerm = showTerm sgr TermPrintDefault Qualified let prTerm = showTerm sgr TermPrintDefault Qualified
let size = sizeConstant sgr let size = sizeConstant sgr
let printed let printed
@@ -200,13 +196,11 @@ 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 $ do show_operations os t sgr = fmap fst $ runCheck $ do
let greps = map valueString (listFlags "grep" os) let greps = map valueString (listFlags "grep" os)
ops <- case ts of ops <- do ty <- checkComputeTerm os sgr t
_:_ -> do 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
_ -> return $ allOpers sgr
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops] let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
printer = showTerm sgr TermPrintDefault printer = showTerm sgr TermPrintDefault
(if isOpt "raw" os then Qualified else Unqualified) (if isOpt "raw" os then Qualified else Unqualified)

View File

@@ -6,7 +6,6 @@ module GF.Grammar.Parser
, pModDef , pModDef
, pModHeader , pModHeader
, pTerm , pTerm
, pExp
, pTopDef , pTopDef
, pBNFCRules , pBNFCRules
, pEBNFRules , pEBNFRules
@@ -32,7 +31,6 @@ import qualified Data.Map as Map
%name pTopDef TopDef %name pTopDef TopDef
%partial pModHeader ModHeader %partial pModHeader ModHeader
%partial pTerm Exp %partial pTerm Exp
%name pExp Exp
%name pBNFCRules ListCFRule %name pBNFCRules ListCFRule
%name pEBNFRules ListEBNFRule %name pEBNFRules ListEBNFRule