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

-val optimization

Browse Source
This commit is contained in:
aarne
2005-01-11 15:06:12 +00:00
parent bb3d2e1d42
commit 87b55df10f
32 changed files with 825 additions and 581 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/GF/Grammar/Compute.hs
View File

@@ -101,6 +101,17 @@ computeTerm gr = comp where
FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . FV
V ptyp ts -> do
vs <- allParamValues gr ptyp
ps <- mapM term2patt vs
let cc = zip ps ts
case v' of
FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV
_ -> case matchPattern cc v' of
Ok (c,g') -> comp (g' ++ g) c
_ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t
_ -> return $ S t' v' -- if v' is not canonical
T _ cc -> case v' of
FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV
_ -> case matchPattern cc v' of
@@ -204,7 +215,8 @@ computeTerm gr = comp where
ts <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
ps <- mapM term2patt vs
let ps' = ps --- PT ptyp (head ps) : tail ps
return $ T (TComp ptyp) (zip ps' ts)
return $ --- V ptyp ts -- to save space, just course of values
T (TComp ptyp) (zip ps' ts)
_ -> do
cs' <- mapM (compBranch g) cs
return $ T i cs' -- happens with variable types