GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-18 07:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

ModuleName and Ident are now distinct types

Browse Source 
This makes the documentation clearer, and can potentially catch more
programming mistakes.
This commit is contained in:
hallgren
2014-10-21 19:20:31 +00:00
parent 3bfcfa157d
commit 391b301881
24 changed files with 156 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/compiler/GF/Grammar/Analyse.hs
View File

@@ -10,6 +10,7 @@ module GF.Grammar.Analyse (
import GF.Grammar.Grammar
import GF.Infra.Ident
import GF.Text.Pretty(render)
--import GF.Infra.Option ---
import GF.Grammar.Macros
import GF.Grammar.Lookup
@@ -20,7 +21,7 @@ import qualified Data.Map as Map
import Data.List (nub)
--import Debug.Trace
stripSourceGrammar :: SourceGrammar -> SourceGrammar
stripSourceGrammar :: Grammar -> Grammar
stripSourceGrammar sgr = mGrammar [(i, m{jments = Map.map stripInfo (jments m)}) | (i,m) <- modules sgr]
stripInfo :: Info -> Info
@@ -42,7 +43,7 @@ constantsInTerm = nub . consts where
QC c -> [c]
_ -> collectOp consts t
constantDeps :: SourceGrammar -> QIdent -> Err [QIdent]
constantDeps :: Grammar -> QIdent -> Err [QIdent]
constantDeps sgr f = return $ nub $ iterFix more start where
start = constants f
more = concatMap constants
@@ -54,23 +55,23 @@ 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
P (Vr r) l -> return (MN r,label2ident l) --- needed if term is received from parser
_ -> Bad ("expected qualified constant, not " ++ show t)
constantDepsTerm :: SourceGrammar -> Term -> Err [Term]
constantDepsTerm :: Grammar -> Term -> Err [Term]
constantDepsTerm sgr t = do
i <- getIdTerm t
cs <- constantDeps sgr i
return $ map Q cs --- losing distinction Q/QC
termsOfConstant :: SourceGrammar -> QIdent -> Err [Term]
termsOfConstant :: Grammar -> QIdent -> Err [Term]
termsOfConstant sgr c = case lookupOverload sgr c of
Ok tts -> return $ concat [[ty,tr] | (_,(ty,tr)) <- tts]
_ -> return $
[ty | Ok ty <- [lookupResType sgr c]] ++ -- type sig may be missing
[ty | Ok ty <- [lookupResDef sgr c]]
sizeConstant :: SourceGrammar -> Term -> Int
sizeConstant :: Grammar -> Term -> Int
sizeConstant sgr t = err (const 0) id $ do
c <- getIdTerm t
fmap (sum . map sizeTerm) $ termsOfConstant sgr c
@@ -131,20 +132,20 @@ sizesModule (_,m) =
in (length tb + sum (map snd tb),tb)
-- the size of a grammar
sizeGrammar :: SourceGrammar -> Int
sizeGrammar :: Grammar -> Int
sizeGrammar = fst . sizesGrammar
sizesGrammar :: SourceGrammar -> (Int,[(Ident,(Int,[(Ident,Int)]))])
sizesGrammar :: Grammar -> (Int,[(ModuleName,(Int,[(Ident,Int)]))])
sizesGrammar g =
let
ms = modules g
mz = [(i,sizesModule m) | m@(i,j) <- ms]
in (length mz + sum (map (fst . snd) mz), mz)
printSizesGrammar :: SourceGrammar -> String
printSizesGrammar :: Grammar -> String
printSizesGrammar g = unlines $
("total" +++ show s):
[showIdent m +++ "total" +++ show i ++++
[render m +++ "total" +++ show i ++++
unlines [indent 2 (showIdent j +++ show k) | (j,k) <- js]
| (m,(i,js)) <- sg
]