summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorbringert <bringert@cs.chalmers.se>2007-01-05 17:34:44 +0000
committerbringert <bringert@cs.chalmers.se>2007-01-05 17:34:44 +0000
commitefb806f22608d9e82ad80e733c20449c80f4c0a6 (patch)
tree18d6011611d444db0cc09bb28e5ac152fc8bf47f /src
parent36a1998ba3f4978c6a9cf9c82e539f395c8566eb (diff)
SISR code now type annotates meta variables directly in grammar, to avoid a separate type annotation step.
Diffstat (limited to 'src')
-rw-r--r--src/GF/Canon/GFCC/DataGFCC.hs4
-rw-r--r--src/GF/Speech/SISR.hs8
-rw-r--r--src/GF/Speech/TransformCFG.hs20
3 files changed, 23 insertions, 9 deletions
diff --git a/src/GF/Canon/GFCC/DataGFCC.hs b/src/GF/Canon/GFCC/DataGFCC.hs
index 389afc5a7..43ce04166 100644
--- a/src/GF/Canon/GFCC/DataGFCC.hs
+++ b/src/GF/Canon/GFCC/DataGFCC.hs
@@ -35,6 +35,10 @@ lookLin :: GFCC -> CId -> CId -> Term
lookLin mcfg lang fun =
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 mcfg lang = realize . linExp mcfg lang
diff --git a/src/GF/Speech/SISR.hs b/src/GF/Speech/SISR.hs
index 71d5612ef..b74b44076 100644
--- a/src/GF/Speech/SISR.hs
+++ b/src/GF/Speech/SISR.hs
@@ -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 (CFVar v) = JS.EVar (var v)
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 "$")
@@ -82,5 +82,7 @@ field x y = JS.EMember x (JS.Ident y)
ass = JS.EAssign
-tree n xs = JS.EObj $ [JS.Prop (JS.Ident "name") (JS.EStr n)]
- ++ [JS.Prop (JS.Ident ("arg"++show i)) x | (i,x) <- zip [0..] xs] \ No newline at end of file
+tree n xs = obj $ [("name", JS.EStr n)] ++ [("arg"++show i, x) | (i,x) <- zip [0..] xs]
+
+obj ps = JS.EObj [JS.Prop (JS.Ident x) y | (x,y) <- ps]
+
diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs
index 3a167eeef..ed1730a3d 100644
--- a/src/GF/Speech/TransformCFG.hs
+++ b/src/GF/Speech/TransformCFG.hs
@@ -23,6 +23,9 @@ module GF.Speech.TransformCFG {- (CFRule_, CFRules,
removeLeftRecursion,
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.CF.PPrCF (prCFCat)
import GF.Data.Utilities
@@ -33,7 +36,7 @@ import GF.Infra.Ident
import GF.Infra.Option
import GF.Infra.Print
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.State (State, get, put, evalState)
@@ -56,7 +59,7 @@ data CFTerm
| CFRes Int
| CFVar Int
| CFConst String
- | CFMeta
+ | CFMeta String
deriving (Eq,Show)
type Cat_ = String
@@ -72,10 +75,13 @@ cfgToCFRules s =
where cfg = stateCFG s
symb = mapSymbol catToString id
catToString = prt
- nameToTerm (Name f prs) = CFObj f (map profileToTerm prs)
- profileToTerm (Unify []) = CFMeta
- profileToTerm (Unify xs) = CFRes (last xs) -- FIXME: unify
- profileToTerm (Constant f) = maybe CFMeta (\x -> CFObj x []) (forestName f)
+ gfcc = stateGFCC s
+ nameToTerm (Name f prs) = CFObj f (zipWith profileToTerm args prs)
+ where C.Typ args _ = lookType gfcc (i2i 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 opts sgr = prCFCat (startCatStateOpts opts sgr)
@@ -83,6 +89,8 @@ getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr)
getStartCatCF :: Options -> StateGrammar -> String
getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"
+stateGFCC :: StateGrammar -> GFCC
+stateGFCC = mkGFCC . mkCanon2gfcc . stateGrammarST
-- | Remove productions which use categories which have no productions
removeEmptyCats :: CFRules -> CFRules