diff options
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/Compile/GFCCtoJS.hs | 1 | ||||
| -rw-r--r-- | src/GF/Compile/GeneratePMCFG.hs | 9 | ||||
| -rw-r--r-- | src/GF/Speech/PGFToCFG.hs | 13 |
3 files changed, 17 insertions, 6 deletions
diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs index 2c3b762da..c8e4e0e4b 100644 --- a/src/GF/Compile/GFCCtoJS.hs +++ b/src/GF/Compile/GFCCtoJS.hs @@ -128,6 +128,7 @@ lins2js p ls = JS.EArray [JS.EArray [sym2js s | s <- Array.elems (sequences p Ar sym2js :: FSymbol -> JS.Expr sym2js (FSymCat n l) = new "ArgProj" [JS.EInt n, JS.EInt l] +sym2js (FSymLit n l) = new "ArgProj" [JS.EInt n, JS.EInt l] sym2js (FSymTok (KS t)) = new "Terminal" [JS.EStr t] new :: String -> [JS.Expr] -> JS.Expr diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs index a20496d70..6a5f9ebdf 100644 --- a/src/GF/Compile/GeneratePMCFG.hs +++ b/src/GF/Compile/GeneratePMCFG.hs @@ -162,7 +162,10 @@ convertArg (C max) nr path lbl_path lin lins = do convertArg (S _) nr path lbl_path lin lins = do (_, args) <- readState let PFCat _ cat rcs tcs = args !! nr - return ((lbl_path, FSymCat nr (index path rcs 0) : lin) : lins) + l = index path rcs 0 + sym | isLiteralCat cat = FSymLit nr l + | otherwise = FSymCat nr l + return ((lbl_path, sym : lin) : lins) where index lbl' (lbl:lbls) idx | lbl' == lbl = idx @@ -257,7 +260,7 @@ expandHOAS abs_defs cnc_defs lincats env = add_hoFun env (n,cat) = let linRec = reverse $ [(l ,[FSymCat 0 i]) | (l,i) <- case arg of {PFCat _ _ rcs _ -> zip rcs [0..]}] ++ - [([],[FSymCat i 0]) | i <- [1..n]] + [([],[FSymLit i 0]) | i <- [1..n]] (env1,lins) = List.mapAccumL addFSeq env linRec newLinRec = mkArray lins @@ -274,7 +277,7 @@ expandHOAS abs_defs cnc_defs lincats env = -- add one PMCFG function for each high-order category: _V : Var -> Cat add_varFun env cat = - let (env1,seqid) = addFSeq env ([],[FSymCat 0 0]) + let (env1,seqid) = addFSeq env ([],[FSymLit 0 0]) lins = replicate (case res of {PFCat _ _ rcs _ -> length rcs}) seqid (env2,funid) = addFFun env1 (FFun _V [[0]] (mkArray lins)) env3 = foldl (\env res -> addProduction env2 res (FApply funid [fcatVar])) diff --git a/src/GF/Speech/PGFToCFG.hs b/src/GF/Speech/PGFToCFG.hs index 37bc9c0e5..ef7f1f868 100644 --- a/src/GF/Speech/PGFToCFG.hs +++ b/src/GF/Speech/PGFToCFG.hs @@ -85,17 +85,24 @@ pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ conc mkRhs = map fsymbolToSymbol . Array.elems containsLiterals :: Array FPointPos FSymbol -> Bool - containsLiterals row = any isLiteralFCat [args!!n | FSymCat n _ <- Array.elems row] + containsLiterals row = any isLiteralFCat [args!!n | FSymCat n _ <- Array.elems row] || + not (null [n | FSymLit n _ <- Array.elems row]) -- only this is needed for PMCFG. + -- The first line is for backward compat. fsymbolToSymbol :: FSymbol -> CFSymbol fsymbolToSymbol (FSymCat n l) = NonTerminal (fcatToCat (args!!n) l) + fsymbolToSymbol (FSymLit n l) = NonTerminal (fcatToCat (args!!n) l) fsymbolToSymbol (FSymTok (KS t)) = Terminal t fixProfile :: Array FPointPos FSymbol -> Profile -> Profile fixProfile row = concatMap positions where - nts = zip [0..] [nt | nt@(FSymCat _ _) <- Array.elems row] - positions i = [k | (k,FSymCat j _) <- nts, j == i] + nts = zip [0..] [j | nt <- Array.elems row, j <- getPos nt] + positions i = [k | (k,j) <- nts, j == i] + + getPos (FSymCat j _) = [j] + getPos (FSymLit j _) = [j] + getPos _ = [] profilesToTerm :: [Profile] -> CFTerm profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps) |