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

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-06-23 08:43:40 +00:00
parent d211d311d0
commit cfdc9932d8
2 changed files with 12 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/GF/Conversion/GFCtoSimple.hs
View File

@@ -4,9 +4,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/06/17 14:15:18 $ -- > CVS $Date: 2005/06/23 09:43:40 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $ -- > CVS $Revision: 1.10 $
-- --
-- Converting GFC to SimpleGFC -- Converting GFC to SimpleGFC
-- --
@@ -27,6 +27,7 @@ import GF.Formalism.SimpleGFC
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Conversion.Types import GF.Conversion.Types
import GF.UseGrammar.Linear (expandLinTables)
import GF.Canon.GFC (CanonGrammar) import GF.Canon.GFC (CanonGrammar)
import GF.Canon.MkGFC (grammar2canon) import GF.Canon.MkGFC (grammar2canon)
import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat) import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat)
@@ -89,9 +90,12 @@ convertCat atom = error $ "GFCtoSimple.convertCat: " ++ show ato
convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm) convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm)
convertConcrete gram (Abs decl args name) = Cnc ltyp largs term convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
where term = fmap (convertTerm gram) $ lookupLin gram $ name2fun name where term = fmap (convertTerm gram . expandTerm gram) $ lookupLin gram $ name2fun name
ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args) ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)
expandTerm :: Env -> A.Term -> A.Term
expandTerm gram term = err error id $ expandLinTables (fst gram) term
convertCType :: Env -> A.CType -> SLinType convertCType :: Env -> A.CType -> SLinType
convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ] convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
convertCType gram (A.Table pt vt) = TblT (convertCType gram pt) (convertCType gram vt) convertCType gram (A.Table pt vt) = TblT (convertCType gram pt) (convertCType gram vt)

8
src/GF/UseGrammar/Linear.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:23:48 $ -- > CVS $Date: 2005/06/23 09:43:40 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.15 $ -- > CVS $Revision: 1.16 $
-- --
-- Linearization for canonical GF. AR 7\/6\/2003 -- Linearization for canonical GF. AR 7\/6\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -104,7 +104,7 @@ expandLinTables gr t = case t of
ts' <- mapM (comp . S t') $ vs ts' <- mapM (comp . S t') $ vs
return $ T ty [Cas [p] t | (p,t) <- zip ps ts'] return $ T ty [Cas [p] t | (p,t) <- zip ps ts']
FV ts -> liftM FV $ mapM exp ts FV ts -> liftM FV $ mapM exp ts
_ -> return t _ -> composOp exp t
where where
alls = allParamValues gr alls = allParamValues gr
exp = expandLinTables gr exp = expandLinTables gr