SISR code now type annotates meta variables directly in grammar, to avoid a separate type annotation step.

This commit is contained in:
bringert
2007-01-05 17:34:44 +00:00
parent 36a1998ba3
commit efb806f226
3 changed files with 23 additions and 9 deletions

View File

@@ -35,6 +35,10 @@ lookLin :: GFCC -> CId -> CId -> Term
lookLin mcfg lang fun = lookLin mcfg lang fun =
lookMap TM fun $ lookMap undefined lang $ concretes mcfg lookMap TM fun $ lookMap undefined lang $ concretes mcfg
-- | Look up the type of a function.
lookType :: GFCC -> CId -> Type
lookType gfcc f = lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
linearize :: GFCC -> CId -> Exp -> String linearize :: GFCC -> CId -> Exp -> String
linearize mcfg lang = realize . linExp mcfg lang linearize mcfg lang = realize . linExp mcfg lang

View File

@@ -68,7 +68,7 @@ profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]
f (CFRes i) = JS.EIndex (JS.EVar children) (JS.EInt (fromIntegral i)) f (CFRes i) = JS.EIndex (JS.EVar children) (JS.EInt (fromIntegral i))
f (CFVar v) = JS.EVar (var v) f (CFVar v) = JS.EVar (var v)
f (CFConst s) = JS.EStr s f (CFConst s) = JS.EStr s
f CFMeta = tree "?" [] f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr typ)]
fmtOut SISROld = JS.EVar (JS.Ident "$") fmtOut SISROld = JS.EVar (JS.Ident "$")
@@ -82,5 +82,7 @@ field x y = JS.EMember x (JS.Ident y)
ass = JS.EAssign ass = JS.EAssign
tree n xs = JS.EObj $ [JS.Prop (JS.Ident "name") (JS.EStr n)] tree n xs = obj $ [("name", JS.EStr n)] ++ [("arg"++show i, x) | (i,x) <- zip [0..] xs]
++ [JS.Prop (JS.Ident ("arg"++show i)) x | (i,x) <- zip [0..] xs]
obj ps = JS.EObj [JS.Prop (JS.Ident x) y | (x,y) <- ps]

View File

@@ -23,6 +23,9 @@ module GF.Speech.TransformCFG {- (CFRule_, CFRules,
removeLeftRecursion, removeLeftRecursion,
removeEmptyCats, removeIdenticalRules) -} where removeEmptyCats, removeIdenticalRules) -} where
import GF.Canon.CanonToGFCC (mkCanon2gfcc)
import qualified GF.Canon.GFCC.AbsGFCC as C
import GF.Canon.GFCC.DataGFCC (GFCC, mkGFCC, lookType)
import GF.Conversion.Types import GF.Conversion.Types
import GF.CF.PPrCF (prCFCat) import GF.CF.PPrCF (prCFCat)
import GF.Data.Utilities import GF.Data.Utilities
@@ -33,7 +36,7 @@ import GF.Infra.Ident
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.Print import GF.Infra.Print
import GF.Speech.Relation import GF.Speech.Relation
import GF.Compile.ShellState (StateGrammar, stateCFG, startCatStateOpts) import GF.Compile.ShellState (StateGrammar, stateCFG, stateGrammarST, startCatStateOpts)
import Control.Monad import Control.Monad
import Control.Monad.State (State, get, put, evalState) import Control.Monad.State (State, get, put, evalState)
@@ -56,7 +59,7 @@ data CFTerm
| CFRes Int | CFRes Int
| CFVar Int | CFVar Int
| CFConst String | CFConst String
| CFMeta | CFMeta String
deriving (Eq,Show) deriving (Eq,Show)
type Cat_ = String type Cat_ = String
@@ -72,10 +75,13 @@ cfgToCFRules s =
where cfg = stateCFG s where cfg = stateCFG s
symb = mapSymbol catToString id symb = mapSymbol catToString id
catToString = prt catToString = prt
nameToTerm (Name f prs) = CFObj f (map profileToTerm prs) gfcc = stateGFCC s
profileToTerm (Unify []) = CFMeta nameToTerm (Name f prs) = CFObj f (zipWith profileToTerm args prs)
profileToTerm (Unify xs) = CFRes (last xs) -- FIXME: unify where C.Typ args _ = lookType gfcc (i2i f)
profileToTerm (Constant f) = maybe CFMeta (\x -> CFObj x []) (forestName f) i2i (IC c) = C.CId c
profileToTerm (C.CId t) (Unify []) = CFMeta t
profileToTerm _ (Unify xs) = CFRes (last xs) -- FIXME: unify
profileToTerm (C.CId t) (Constant f) = maybe (CFMeta t) (\x -> CFObj x []) (forestName f)
getStartCat :: Options -> StateGrammar -> String getStartCat :: Options -> StateGrammar -> String
getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr) getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr)
@@ -83,6 +89,8 @@ getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr)
getStartCatCF :: Options -> StateGrammar -> String getStartCatCF :: Options -> StateGrammar -> String
getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s" getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"
stateGFCC :: StateGrammar -> GFCC
stateGFCC = mkGFCC . mkCanon2gfcc . stateGrammarST
-- | Remove productions which use categories which have no productions -- | Remove productions which use categories which have no productions
removeEmptyCats :: CFRules -> CFRules removeEmptyCats :: CFRules -> CFRules