GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-27 13:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

a major refactoring in the C and the Haskell runtimes. Note incompatible change in the PGF format!!!

Browse Source 
The following are the outcomes:

   - Predef.nonExist is fully supported by both the Haskell and the C runtimes

   - Predef.BIND is now an internal compiler defined token. For now
     it behaves just as usual for the Haskell runtime, i.e. it generates &+.
     However, the special treatment will let us to handle it properly in 
     the C runtime.

   - This required a major change in the PGF format since both 
     nonExist and BIND may appear inside 'pre' and this was not supported
     before.
This commit is contained in:
kr.angelov
2013-09-27 15:09:48 +00:00
parent b138899512
commit 426bc49a52
28 changed files with 330 additions and 371 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -14,7 +14,7 @@ module GF.Compile.GeneratePMCFG
) where
import PGF.CId
import PGF.Data(Alternative(..),CncCat(..),Symbol(..),fidVar)
import PGF.Data(CncCat(..),Symbol(..),fidVar)
import GF.Infra.Option
import GF.Grammar hiding (Env, mkRecord, mkTable)
@@ -376,30 +376,24 @@ convertTerm opts sel ctype (FV vars) = do term <- variants vars
convertTerm opts sel ctype (C t1 t2) = do v1 <- convertTerm opts sel ctype t1
v2 <- convertTerm opts sel ctype t2
return (CStr (concat [s | CStr s <- [v1,v2]]))
convertTerm opts sel ctype (K t) = return (CStr [SymKS [t]])
convertTerm opts sel ctype (K t) = return (CStr [SymKS t])
convertTerm opts sel ctype Empty = return (CStr [])
convertTerm opts sel ctype (Alts s alts)
= return (CStr [SymKP (strings s) [Alt (strings u) (strings v) | (u,v) <- alts]])
where
strings (K s) = [s]
strings (C u v) = strings u ++ strings v
strings (Strs ss) = concatMap strings ss
strings (EPatt p) = getPatts p
strings Empty = [""]
strings t = bug $ "strings "++show t
getPatts p =
case p of
PAlt a b -> getPatts a ++ getPatts b
PString s -> [s]
PSeq a b -> [s ++ t | s <- getPatts a, t <- getPatts b]
_ -> ppbug $ hang (text "not valid pattern in pre expression:")
4
(ppPatt Unqualified 0 p)
convertTerm opts sel ctype (Alts s alts)= do CStr s <- convertTerm opts CNil ctype s
alts <- forM alts $ \(u,Strs ps) -> do
CStr u <- convertTerm opts CNil ctype u
ps <- mapM (convertTerm opts CNil ctype) ps
return (u,map unSym ps)
return (CStr [SymKP s alts])
where
unSym (CStr []) = ""
unSym (CStr [SymKS t]) = t
unSym _ = ppbug $ hang (text "invalid prefix in pre expression:") 4 (ppU 0 (Alts s alts))
convertTerm opts sel ctype (Q (m,f))
| m == cPredef &&
f == cNonExist = return (CStr [SymNE])
| m == cPredef &&
f == cBIND = return (CStr [SymBIND])
convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))
| l `elem` map fst rs2 = convertTerm opts sel ctype t2
@@ -492,7 +486,7 @@ addSequencesV seqs (CRec vs) = let !(seqs1,vs1) = mapAccumL' (\seqs (lbl,b) ->
addSequencesV seqs (CTbl pt vs)=let !(seqs1,vs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b
in (seqs',(trm,b'))) seqs vs
in (seqs1,CTbl pt vs1)
addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs (optimizeLin lin)
addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs lin
in (seqs1,CStr seqid)
addSequencesV seqs (CPar i) = (seqs,CPar i)
@@ -502,16 +496,6 @@ mapAccumL' f s (x:xs) = (s'',y:ys)
where !(s', y ) = f s x
!(s'',ys) = mapAccumL' f s' xs
optimizeLin [] = []
optimizeLin lin@(SymKS _ : _) =
let (ts,lin') = getRest lin
in SymKS ts : optimizeLin lin'
where
getRest (SymKS ts : lin) = let (ts1,lin') = getRest lin
in (ts++ts1,lin')
getRest lin = ([],lin)
optimizeLin (sym : lin) = sym : optimizeLin lin
addSequence :: SeqSet -> [Symbol] -> (SeqSet,SeqId)
addSequence seqs lst =
case Map.lookup seq seqs of
@@ -629,4 +613,4 @@ mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
bug msg = ppbug (text msg)
ppbug = error . render . hang (text "Internal error in GeneratePMCFG:") 4
ppU = ppTerm Unqualified
ppU = ppTerm Unqualified