Yay!! Direct generation of PMCFG from GF grammar

5 files changed, 19 insertions, 9 deletions

diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 2e6f1f1a7..19e786b2a 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -119,7 +119,7 @@ data Term =
  | Cn Ident                      -- ^ constant
  | Con Ident                     -- ^ constructor
  | Sort Ident                    -- ^ basic type
- | EInt Integer                  -- ^ integer literal
+ | EInt Int                      -- ^ integer literal
  | EFloat Double                 -- ^ floating point literal
  | K String                      -- ^ string literal or token: @\"foo\"@
  | Empty                         -- ^ the empty string @[]@
@@ -171,7 +171,7 @@ data Patt =
  | PW                     -- ^ wild card pattern: @_@
  | PR [(Label,Patt)]      -- ^ record pattern: @{r = p ; ...}@  -- only concrete
  | PString String         -- ^ string literal pattern: @\"foo\"@  -- only abstract
- | PInt    Integer        -- ^ integer literal pattern: @12@    -- only abstract
+ | PInt    Int            -- ^ integer literal pattern: @12@    -- only abstract
  | PFloat Double          -- ^ float literal pattern: @1.2@    -- only abstract
  | PT Type Patt           -- ^ type-annotated pattern
 
diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x
index 492c7ce8e..ca796808b 100644
--- a/src/compiler/GF/Grammar/Lexer.x
+++ b/src/compiler/GF/Grammar/Lexer.x
@@ -112,7 +112,7 @@ data Token
  | T_where
  | T_with
  | T_String  String          -- string literals
- | T_Integer Integer         -- integer literals
+ | T_Integer Int             -- integer literals
  | T_Double  Double          -- double precision float literals
  | T_LString String
  | T_Ident   Ident
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index 3380a55c0..9b9c45ba7 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -166,6 +166,12 @@ unzipR r = (ls, map snd ts) where (ls,ts) = unzip r
 mkAssign :: [(Label,Term)] -> [Assign]
 mkAssign lts = [assign l t | (l,t) <- lts]
 
+projectRec :: Label -> [Assign] -> Term
+projectRec l rs =
+  case lookup l rs of
+    Just (_,t) -> t
+    Nothing    -> error (render (text "no value for label" <+> ppLabel l))
+
 zipAssign :: [Label] -> [Term] -> [Assign]
 zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
 
@@ -199,7 +205,7 @@ typeTok   = Sort cTok
 typeStrs  = Sort cStrs
 
 typeString, typeFloat, typeInt :: Term
-typeInts :: Integer -> Term
+typeInts :: Int -> Term
 typePBool :: Term
 typeError :: Term
 
@@ -210,7 +216,7 @@ typeInts i = App (cnPredef cInts) (EInt i)
 typePBool = cnPredef cPBool
 typeError = cnPredef cErrorType
 
-isTypeInts :: Term -> Maybe Integer
+isTypeInts :: Term -> Maybe Int
 isTypeInts (App c (EInt i)) | c == cnPredef cInts = Just i
 isTypeInts _                                      = Nothing
 
@@ -299,7 +305,7 @@ freshAsTerm s = Vr (varX (readIntArg s))
 string2term :: String -> Term
 string2term = K
 
-int2term :: Integer -> Term
+int2term :: Int -> Term
 int2term = EInt
 
 float2term :: Double -> Term
diff --git a/src/compiler/GF/Grammar/Predef.hs b/src/compiler/GF/Grammar/Predef.hs
index 370497cc7..f16765433 100644
--- a/src/compiler/GF/Grammar/Predef.hs
+++ b/src/compiler/GF/Grammar/Predef.hs
@@ -19,6 +19,7 @@ module GF.Grammar.Predef
           , cInt
           , cFloat
           , cString
+          , cVar
           , cInts
           , cPBool
           , cErrorType
@@ -73,6 +74,9 @@ cFloat = identC (BS.pack "Float")
 cString :: Ident
 cString = identC (BS.pack "String")
 
+cVar :: Ident
+cVar = identC (BS.pack "__gfVar")
+
 cInts :: Ident
 cInts = identC (BS.pack "Ints")
 
@@ -89,7 +93,7 @@ cUndefinedType :: Ident
 cUndefinedType = identC (BS.pack "UndefinedType")
 
 isLiteralCat :: Ident -> Bool
-isLiteralCat c = elem c [cInt,cString,cFloat]
+isLiteralCat c = elem c [cInt,cString,cFloat,cVar]
 
 cPTrue :: Ident
 cPTrue  = identC (BS.pack "PTrue")
diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs
index 69c9e8860..3f97dd390 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -171,7 +171,7 @@ ppTerm q d (Q  id)     = ppQIdent q id
 ppTerm q d (QC id)     = ppQIdent q id

 ppTerm q d (Sort id)   = ppIdent id

 ppTerm q d (K s)       = str s

-ppTerm q d (EInt n)    = integer n

+ppTerm q d (EInt n)    = int n

 ppTerm q d (EFloat f)  = double f

 ppTerm q d (Meta _)    = char '?'

 ppTerm q d (Empty)     = text "[]"

@@ -204,7 +204,7 @@ ppPatt q d (PMacro id)  = char '#' <> ppIdent id
 ppPatt q d (PM id)      = char '#' <> ppQIdent q id

 ppPatt q d PW           = char '_'

 ppPatt q d (PV id)      = ppIdent id

-ppPatt q d (PInt n)     = integer n

+ppPatt q d (PInt n)     = int n

 ppPatt q d (PFloat f)   = double f

 ppPatt q d (PString s)  = str s

 ppPatt q d (PR xs)      = braces (hsep (punctuate semi [ppLabel l <+> equals <+> ppPatt q 0 e | (l,e) <- xs]))