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

CSEE now works fine

Browse Source
This commit is contained in:
aarne
2005-09-20 08:32:55 +00:00
parent 263beccd56
commit 6d179267de
8 changed files with 70 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/Canon/Look.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/19 16:11:06 $
-- > CVS $Date: 2005/09/20 09:32:56 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.16 $
-- > CVS $Revision: 1.17 $
--
-- lookup in GFC. AR 2003
-----------------------------------------------------------------------------
@@ -187,7 +187,7 @@ ccompute cnc = comp []
_ -> return t
where
compt = comp g xs
look c = lookupGlobal cnc c
look c = lookupGlobal cnc c >>= compt
lookVar c co = case lookup c co of
Just t -> return t

11
src/GF/Canon/Subexpressions.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/19 13:01:18 $
-- > CVS $Date: 2005/09/20 09:32:56 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.3 $
-- > CVS $Revision: 1.4 $
--
-- Common subexpression elimination.
-- all tables. AR 18\/9\/2005.
@@ -80,11 +80,14 @@ unSubelimCanon gr@(M.MGrammar modules) =
unSubelimModule :: CanonModule -> CanonModule
unSubelimModule mo@(i,m) = case m of
M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) ->
M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) | hasSub ljs ->
(i, M.ModMod (M.Module mt st fs me ops
(rebuild (map unparInfo (tree2list js)))))
(rebuild (map unparInfo ljs))))
where ljs = tree2list js
_ -> (i,m)
where
-- perform this iff the module has opers
hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
unparInfo (c,info) = case info of
CncFun k xs t m -> [(c, CncFun k xs (unparTerm t) m)]
ResOper _ _ -> []