msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

don't count app nodes in term size

Browse Source
This commit is contained in:
aarne
2011-09-26 13:56:39 +00:00
parent ff4929e25e
commit a83b6bea62
2 changed files with 2 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -80,7 +80,7 @@ sizeConstant sgr t = err (const 0) id $ do
-- ground terms count as 1, i.e. as "one work" each -- ground terms count as 1, i.e. as "one work" each
sizeTerm :: Term -> Int sizeTerm :: Term -> Int
sizeTerm t = case t of sizeTerm t = case t of
App c a -> 1 + sizeTerm c + sizeTerm a App c a -> sizeTerm c + sizeTerm a -- app nodes don't count
Abs _ _ b -> 2 + sizeTerm b Abs _ _ b -> 2 + sizeTerm b
Prod _ _ a b -> 2 + sizeTerm a + sizeTerm b Prod _ _ a b -> 2 + sizeTerm a + sizeTerm b
S c a -> 1 + sizeTerm c + sizeTerm a S c a -> 1 + sizeTerm c + sizeTerm a

2
src/compiler/GFI.hs
View File

@@ -191,7 +191,7 @@ execute1 opts gfenv0 s0 =
ops <- case xs of ops <- case xs of
_:_ -> do _:_ -> do
let ts = [t | Right t <- map (runP pExp . encodeUnicode utf8) xs] let ts = [t | Right t <- map (runP pExp . encodeUnicode utf8) xs]
err error (return . nub . (ts ++) . concat) $ mapM (constantDepsTerm sgr) ts err error (return . nub . concat) $ mapM (constantDepsTerm sgr) ts
_ -> error "expected one or more qualified constants as argument" _ -> 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