1
0
forked from GitHub/gf-core

the sd -size command now shows the size of all code needed for defining an oper

This commit is contained in:
aarne
2011-09-22 12:11:03 +00:00
parent d97101154f
commit ac51d644fc
3 changed files with 30 additions and 13 deletions

View File

@@ -791,9 +791,11 @@ allCommands env@(pgf, mos) = Map.fromList [
"This command must be a line of its own, and thus cannot be a part of a pipe."
],
options = [
("size","show the size of the source code for each constants (number of constructors)")
],
examples = [
"sd ParadigmsEng.mkV -- show all constants on which this one depends"
"sd ParadigmsEng.mkV -- show all constants on which this one depends",
"sd -size ParadigmsEng.mkV -- show all constants on which this one depends, together with size"
],
needsTypeCheck = False
}),

View File

@@ -2,6 +2,7 @@ module GF.Grammar.Analyse (
stripSourceGrammar,
constantDepsTerm,
sizeTerm,
sizeConstant,
sizesModule,
sizesGrammar,
printSizesGrammar
@@ -45,7 +46,7 @@ constantsInTerm = nub . consts where
constantDeps :: SourceGrammar -> QIdent -> Err [Term]
constantDeps sgr f = do
ts <- deps f
let cs = [i | t <- ts, i <- getId t]
let cs = [i | t <- ts, Ok i <- [getIdTerm t]]
ds <- mapM deps cs
return $ nub $ concat $ ts:ds
where
@@ -56,18 +57,25 @@ constantDeps sgr f = do
ty <- lookupResType sgr c
tr <- lookupResDef sgr c
return $ constantsInTerm ty ++ constantsInTerm tr
getId t = case t of
Q i -> [i]
QC i -> [i]
_ -> []
constantDepsTerm :: SourceGrammar -> Term -> Err [Term]
constantDepsTerm sgr t = case t of
Q i -> constantDeps sgr i
QC i -> constantDeps sgr i
P (Vr r) l -> constantDeps sgr $ (r,label2ident l) ---
getIdTerm :: Term -> Err QIdent
getIdTerm t = case t of
Q i -> return i
QC i -> return i
P (Vr r) l -> return (r,label2ident l) --- needed if term is received from parser
_ -> Bad ("expected qualified constant, not " ++ show t)
constantDepsTerm :: SourceGrammar -> Term -> Err [Term]
constantDepsTerm sgr t = do
i <- getIdTerm t
constantDeps sgr i
sizeConstant :: SourceGrammar -> Term -> Int
sizeConstant sgr t = err (const 0) id $ do
c <- getIdTerm t
ty <- return $ err (const 0) sizeTerm $ lookupResType sgr c -- if no type sig, return 0
tr <- return $ err (const 0) sizeTerm $ lookupResDef sgr c
return $ ty + tr
-- the number of constructors in a term, ignoring position information and unnecessary types
-- ground terms count as 1, i.e. as "one work" each

View File

@@ -193,8 +193,15 @@ execute1 opts gfenv0 s0 =
let Right t = runP pExp (encodeUnicode utf8 (unwords ts))
err error return $ constantDepsTerm sgr t
_ -> error "give a term as argument"
let printer = showTerm sgr TermPrintDefault Qualified
putStrLn $ unwords $ map printer ops
let prTerm = showTerm sgr TermPrintDefault Qualified
let size = sizeConstant sgr
let printed
| elem "-size" os =
let sz = map size ops in
unlines $ ("total: " ++ show (sum sz)) :
[prTerm f ++ "\t" ++ show s | (f,s) <- zip ops sz]
| otherwise = unwords $ map prTerm ops
putStrLn $ printed
continue gfenv
show_operations ws =