diff options
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/GFCCtoJS.hs | 2 | ||||
| -rw-r--r-- | src/GF/Compile/GenerateFCFG.hs | 5 | ||||
| -rw-r--r-- | src/GF/Compile/GeneratePMCFG.hs | 21 |
3 files changed, 20 insertions, 8 deletions
diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs index 8ca321eaa..6a82d02d9 100644 --- a/src/GF/Compile/GFCCtoJS.hs +++ b/src/GF/Compile/GFCCtoJS.hs @@ -129,7 +129,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] +sym2js (FSymKS [t]) = new "Terminal" [JS.EStr t] new :: String -> [JS.Expr] -> JS.Expr new f xs = JS.ENew (JS.Ident f) xs diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs index 7597e71dd..096572659 100644 --- a/src/GF/Compile/GenerateFCFG.hs +++ b/src/GF/Compile/GenerateFCFG.hs @@ -158,7 +158,10 @@ translateLin idxArgs ((lbl,syms) : lins) grammarEnv lbl' | lbl' == lbl = addFSeq grammarEnv (lbl,map instSym syms) | otherwise = translateLin idxArgs lins grammarEnv lbl' where - instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok + instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) + (\t -> case t of + KS s -> FSymKS [s] + KP strs vars -> FSymKP strs vars) instCat lbl nr xnr nr' ((idx,xargs):idxArgs) | nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr in FSymCat (nr'+xnr) (index lbl rcs 0) diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs index 667b403b5..ab79f9b30 100644 --- a/src/GF/Compile/GeneratePMCFG.hs +++ b/src/GF/Compile/GeneratePMCFG.hs @@ -213,10 +213,22 @@ addSequences' env (Return v) = let (env1,v1) = addSequences env v addSequences :: GrammarEnv -> Value [FSymbol] -> (GrammarEnv, Value SeqId) addSequences env (Rec vs) = let (env1,vs1) = List.mapAccumL addSequences' env vs in (env1,Rec vs1) -addSequences env (Str lin) = let (env1,seqid) = addFSeq env lin +addSequences env (Str lin) = let (env1,seqid) = addFSeq env (optimizeLin lin) in (env1,Str seqid) addSequences env (Con i) = (env,Con i) + +optimizeLin [] = [] +optimizeLin lin@(FSymKS _ : _) = + let (ts,lin') = getRest lin + in FSymKS ts : optimizeLin lin' + where + getRest (FSymKS ts : lin) = let (ts1,lin') = getRest lin + in (ts++ts1,lin') + getRest lin = ([],lin) +optimizeLin (sym : lin) = sym : optimizeLin lin + + convertTerm :: TermMap -> FPath -> Term -> Term -> CnvMonad (Value [FSymbol]) convertTerm cnc_defs sel ctype (V nr) = convertArg ctype nr (reverse sel) convertTerm cnc_defs sel ctype (C nr) = convertCon ctype nr (reverse sel) @@ -227,11 +239,8 @@ convertTerm cnc_defs sel ctype (FV vars) = do term <- variants vars convertTerm cnc_defs sel ctype term convertTerm cnc_defs sel ctype (S ts) = do vs <- mapM (convertTerm cnc_defs sel ctype) ts return (Str (concat [s | Str s <- vs])) ---convertTerm cnc_defs sel ctype (K t) = return (Str [FSymTok t]) -convertTerm cnc_defs sel ctype (K (KS t)) = return (Str [FSymTok (KS t)]) -convertTerm cnc_defs sel ctype (K (KP strs vars)) = - do toks <- variants (strs:[strs' | Alt strs' _ <- vars]) - return (Str (map (FSymTok . KS) toks)) +convertTerm cnc_defs sel ctype (K (KS t)) = return (Str [FSymKS [t]]) +convertTerm cnc_defs sel ctype (K (KP s v))=return (Str [FSymKP s v]) convertTerm cnc_defs sel ctype (F id) = case Map.lookup id cnc_defs of Just term -> convertTerm cnc_defs sel ctype term Nothing -> error ("unknown id " ++ prCId id) |