added wrapper functions for expression manipulations in PGF. The Haskell API now uses the wrappers

src/GF/Compile/GFCCtoHaskell.hs

@@ -59,11 +59,11 @@ haskPreamble name =
   "  gf :: a -> Tree",
   "  fg :: Tree -> a",
   "",
-  predefInst "GString" "String"  "Lit (LStr s)",
+  predefInst "GString" "String"  "unStr"    "mkStr",
   "",
-  predefInst "GInt"    "Integer" "Lit (LInt s)",
+  predefInst "GInt"    "Integer" "unInt"    "mkInt",
   "",
-  predefInst "GFloat"  "Double"  "Lit (LFlt s)",
+  predefInst "GFloat"  "Double"  "unDouble" "mkDouble",
   "",
   "----------------------------------------------------",
   "-- below this line machine-generated",
@@ -71,14 +71,14 @@ haskPreamble name =
   ""
  ]
 
-predefInst gtyp typ patt = 
+predefInst gtyp typ destr consr = 
   "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++
   "instance Gf" +++ gtyp +++ "where" ++++
-  "  gf (" ++ gtyp +++ "s) =" +++ patt ++++
+  "  gf (" ++ gtyp +++ "x) =" +++ consr +++ "x" ++++
   "  fg t =" ++++
-  "    case t of" ++++
-  "     " +++ patt +++ " ->" +++ gtyp +++ "s" ++++
-  "      _ -> error (\"no" +++ gtyp +++ "\" ++ show t)"
+  "    case "++destr++" t of" ++++
+  "      Just x  -> " +++ gtyp +++ "x" ++++
+  "      Nothing -> error (\"no" +++ gtyp +++ "\" ++ show t)"
 
 type OIdent = String
 
@@ -151,7 +151,7 @@ hInstance gId lexical m (cat,rules)
  | otherwise =
   "instance Gf" +++ gId cat +++ "where\n" ++
   unlines ([mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules]
-            ++ if lexical cat then ["  gf (" ++ lexicalConstructor cat +++ "x) = Fun (mkCId x) []"] else [])
+            ++ if lexical cat then ["  gf (" ++ lexicalConstructor cat +++ "x) = mkApp (mkCId x) []"] else [])
  where
    ec = elemCat cat
    baseVars = mkVars (baseSize (cat,rules))
@@ -159,7 +159,7 @@ hInstance gId lexical m (cat,rules)
      (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
      "=" +++ mkRHS f xx'
    mkVars n = ["x" ++ show i | i <- [1..n]]
-   mkRHS f vars = "Fun (mkCId \"" ++ f ++ "\")" +++ 
+   mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++ 
 		   "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
 
 
@@ -167,14 +167,14 @@ hInstance gId lexical m (cat,rules)
 fInstance _ _ m (cat,[]) = ""
 fInstance gId lexical m (cat,rules) =
   "  fg t =" ++++
-  "    case t of" ++++
+  "    case unApp t of" ++++
   unlines [mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] ++++
-  (if lexical cat then "      Fun i [] -> " ++ lexicalConstructor cat +++ "(prCId i)" else "") ++++
+  (if lexical cat then "      (i,[]) -> " ++ lexicalConstructor cat +++ "(prCId i)" else "") ++++
   "      _ -> error (\"no" +++ cat ++ " \" ++ show t)"
    where
     mkInst f xx =
-     "      Fun i " ++
-     "[" ++ prTList "," xx' ++ "]" +++
+     "      Just (i," ++
+     "[" ++ prTList "," xx' ++ "])" +++
      "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx'
        where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
 	     mkRHS f vars 

src/GF/Compile/GFCCtoJS.hs

@@ -1,7 +1,7 @@
 module GF.Compile.GFCCtoJS (pgf2js) where
 
 import PGF.CId
-import PGF.Data
+import PGF.Data hiding (mkStr)
 import qualified PGF.Macros as M
 import qualified GF.JavaScript.AbsJS as JS
 import qualified GF.JavaScript.PrintJS as JS

src/PGF.hs

@@ -41,6 +41,11 @@ module PGF(
            -- ** Expr
            Expr,
            showExpr, readExpr,
+           mkApp,    unApp,
+           mkStr,    unStr,
+           mkInt,    unInt,
+           mkDouble, unDouble,
+
 
            -- * Operations
            -- ** Linearization
@@ -106,7 +111,7 @@ import Control.Monad
 -- | Reads file in Portable Grammar Format and produces
 -- 'PGF' structure. The file is usually produced with:
 --
--- > $ gfc --make <grammar file name>
+-- > $ gf -make <grammar file name>
 readPGF  :: FilePath -> IO PGF
 
 -- | Linearizes given expression as string in the language

src/PGF/Expr.hs

@@ -1,6 +1,11 @@
 module PGF.Expr(Tree, Expr(..), Literal(..), Patt(..), Equation(..),
                 readExpr, showExpr, pExpr, ppExpr, ppPatt,
 
+                mkApp,    unApp,
+                mkStr,    unStr,
+                mkInt,    unInt,
+                mkDouble, unDouble,
+
                 normalForm,
 
                 -- needed in the typechecker
@@ -81,6 +86,41 @@ showExpr vars = PP.render . ppExpr 0 vars
 instance Read Expr where
     readsPrec _ = RP.readP_to_S pExpr
 
+-- | Constructs an expression by applying a function to a list of expressions
+mkApp :: CId -> [Expr] -> Expr
+mkApp f es = foldl EApp (EFun f) es
+
+-- | Decomposes an expression into application of function
+unApp :: Expr -> Maybe (CId,[Expr])
+unApp = extract []
+  where
+    extract es (EFun f)     = Just (f,es)
+    extract es (EApp e1 e2) = extract (e2:es) e1
+    extract es _            = Nothing
+
+-- | Constructs an expression from string literal
+mkStr :: String -> Expr
+mkStr s = ELit (LStr s)
+
+-- | Decomposes an expression into string literal
+unStr :: Expr -> Maybe String
+unStr (ELit (LStr s)) = Just s
+
+-- | Constructs an expression from integer literal
+mkInt :: Integer -> Expr
+mkInt i = ELit (LInt i)
+
+-- | Decomposes an expression into integer literal
+unInt :: Expr -> Maybe Integer
+unInt (ELit (LInt i)) = Just i
+
+-- | Constructs an expression from real number literal
+mkDouble :: Double -> Expr
+mkDouble f = ELit (LFlt f)
+
+-- | Decomposes an expression into real number literal
+unDouble :: Expr -> Maybe Double
+unDouble (ELit (LFlt f)) = Just f
 
 -----------------------------------------------------
 -- Parsing