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

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-04-12 09:49:44 +00:00
parent 5f25c82817
commit fa6ba9a531
35 changed files with 285 additions and 3046 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/11 13:52:48 $
-- > CVS $Date: 2005/04/12 10:49:44 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
-- > CVS $Revision: 1.2 $
--
-- Converting GFC to SimpleGFC
--
@@ -20,6 +20,7 @@ import qualified AbsGFC as A
import qualified Ident as I
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
import GF.Conversion.Types
import GFC (CanonGrammar)
import MkGFC (grammar2canon)
@@ -35,7 +36,7 @@ import GF.Infra.Print
type Env = (CanonGrammar, I.Ident)
convertGrammar :: Env -> SimpleGrammar
convertGrammar :: Env -> SGrammar
convertGrammar gram = trace2 "converting language" (show (snd gram)) $
tracePrt "#simpleGFC rules" (show . length) $
[ convertAbsFun gram fun typing |
@@ -43,7 +44,7 @@ convertGrammar gram = trace2 "converting language" (show (snd gram)) $
A.AbsDFun fun typing _ <- defs ]
where A.Gr modules = grammar2canon (fst gram)
convertAbsFun :: Env -> I.Ident -> A.Exp -> SimpleRule
convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule
convertAbsFun gram fun typing = Rule abs cnc
where abs = convertAbstract [] fun typing
cnc = convertConcrete gram abs
@@ -51,13 +52,15 @@ convertAbsFun gram fun typing = Rule abs cnc
----------------------------------------------------------------------
-- abstract definitions
convertAbstract :: [Decl] -> Name -> A.Exp -> Abstract Decl Name
convertAbstract :: [SDecl] -> Fun -> A.Exp -> Abstract SDecl Name
convertAbstract env fun (A.EProd x a b)
= convertAbstract ((x' ::: convertType [] a) : env) fun b
where x' = if x==I.identC "h_" then anyVar else x
convertAbstract env fun a = Abs (anyVar ::: convertType [] a) (reverse env) fun
convertAbstract env fun a
= Abs (anyVar ::: convertType [] a) (reverse env) name
where name = Name fun [ Unify [n] | n <- [0 .. length env-1] ]
convertType :: [Atom] -> A.Exp -> Type
convertType :: [Atom] -> A.Exp -> SType
convertType args (A.EApp a (A.EAtom at)) = convertType (convertAtom at : args) a
convertType args (A.EAtom at) = convertCat at :@ args
@@ -65,19 +68,19 @@ convertAtom :: A.Atom -> Atom
convertAtom (A.AC con) = ACon con
convertAtom (A.AV var) = AVar var
convertCat :: A.Atom -> Cat
convertCat :: A.Atom -> SCat
convertCat (A.AC (A.CIQ _ cat)) = cat
convertCat at = error $ "convertCat: " ++ show at
----------------------------------------------------------------------
-- concrete definitions
convertConcrete :: Env -> Abstract Decl Name -> Concrete LinType (Maybe Term)
convertConcrete gram (Abs decl args fun) = Cnc ltyp largs term
where term = fmap (convertTerm gram) $ lookupLin gram fun
convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm)
convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
where term = fmap (convertTerm gram) $ lookupLin gram $ name2fun name
ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)
convertCType :: Env -> A.CType -> LinType
convertCType :: Env -> A.CType -> SLinType
convertCType gram (A.RecType rec)
= RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
convertCType gram (A.Table ptype vtype)
@@ -86,7 +89,7 @@ convertCType gram ct@(A.Cn con) = ConT con $ map (convertTerm gram) $ groundTerm
convertCType gram (A.TStr) = StrT
convertCType gram (A.TInts n) = error "convertCType: cannot handle 'TInts' constructor"
convertTerm :: Env -> A.Term -> Term
convertTerm :: Env -> A.Term -> STerm
convertTerm gram (A.Arg arg) = convertArgVar arg
convertTerm gram (A.Con con terms) = con :^ map (convertTerm gram) terms
convertTerm gram (A.LI var) = Var var
@@ -108,7 +111,7 @@ convertTerm gram (A.E) = Empty
convertTerm gram (A.I con) = error "convertTerm: cannot handle 'I' constructor"
convertTerm gram (A.EInt int) = error "convertTerm: cannot handle 'EInt' constructor"
convertArgVar :: A.ArgVar -> Term
convertArgVar :: A.ArgVar -> STerm
convertArgVar (A.A cat nr) = Arg (fromInteger nr) cat emptyPath
convertArgVar (A.AB cat bindings nr) = Arg (fromInteger nr) cat emptyPath
@@ -120,11 +123,11 @@ convertPatt (A.PI n) = error "convertPatt: cannot handle 'PI' constructor"
----------------------------------------------------------------------
lookupLin :: Env -> Name -> Maybe A.Term
lookupLin :: Env -> Fun -> Maybe A.Term
lookupLin gram fun = err fail Just $
Look.lookupLin (fst gram) (A.CIQ (snd gram) fun)
lookupCType :: Env -> Decl -> A.CType
lookupCType :: Env -> SDecl -> A.CType
lookupCType env decl
= errVal CMacros.defLinType $
Look.lookupLincat (fst env) (A.CIQ (snd env) (decl2cat decl))