added PGF(pIdent,pExpr)

src/runtime/haskell/PGF.hsc

@@ -0,0 +1,117 @@
+module PGF ( PGF2.PGF, readPGF
+           , abstractName
+
+           , CId, mkCId, wildCId, showCId, readCId, pIdent
+
+           , PGF2.categories, PGF2.categoryContext, PGF2.startCat
+           , functions, functionsByCat
+
+           , PGF2.Expr(..), PGF2.Literal(..), Tree
+           , PGF2.readExpr, PGF2.showExpr, pExpr
+           , PGF2.mkAbs,    PGF2.unAbs
+           , PGF2.mkApp,    PGF2.unApp, PGF2.unapply
+           , PGF2.mkStr,    PGF2.unStr
+           , PGF2.mkInt,    PGF2.unInt
+           , PGF2.mkDouble, PGF2.unDouble
+           , PGF2.mkFloat,  PGF2.unFloat
+           , PGF2.mkMeta,   PGF2.unMeta
+           , PGF2.exprSize, PGF2.exprFunctions
+
+           , PGF2.Type(..), PGF2.Hypo
+           , PGF2.readType, PGF2.showType
+           , PGF2.mkType, PGF2.unType
+           , PGF2.mkHypo, PGF2.mkDepHypo, PGF2.mkImplHypo
+
+           , PGF2.PGFError(..)
+           ) where
+
+import PGF2.FFI
+
+import Foreign
+import Foreign.C
+import Control.Exception(mask_)
+import Control.Monad
+import qualified PGF2 as PGF2
+import qualified Text.ParserCombinators.ReadP as RP
+import System.IO.Unsafe(unsafePerformIO)
+
+#include <pgf/pgf.h>
+
+newtype CId = CId String deriving (Show,Read,Eq,Ord)
+
+type Language = CId
+
+readPGF = PGF2.readPGF
+
+
+readLanguage = readCId
+showLanguage (CId s) = s
+
+
+abstractName gr = CId (PGF2.abstractName gr)
+
+
+categories gr = map CId (PGF2.categories gr)
+
+
+functions gr  = map CId (PGF2.functions gr)
+functionsByCat gr (CId c) = map CId (PGF2.functionsByCat gr c)
+
+type Tree = PGF2.Expr
+
+
+mkCId x = CId x
+wildCId = CId "_"
+showCId (CId x) = x
+readCId s = Just (CId s)
+
+
+pIdent :: RP.ReadP String
+pIdent = 
+  liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
+  `mplus`
+  do RP.char '\''
+     cs <- RP.many1 insideChar
+     RP.char '\''
+     return cs
+--  where
+insideChar = RP.readS_to_P $ \s ->
+  case s of
+    []             -> []
+    ('\\':'\\':cs) -> [('\\',cs)]
+    ('\\':'\'':cs) -> [('\'',cs)]
+    ('\\':cs)      -> []
+    ('\'':cs)      -> []
+    (c:cs)         -> [(c,cs)]
+
+isIdentFirst c =
+  (c == '_') ||
+  (c >= 'a' && c <= 'z') ||
+  (c >= 'A' && c <= 'Z') ||
+  (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
+isIdentRest c = 
+  (c == '_') ||
+  (c == '\'') ||
+  (c >= '0' && c <= '9') ||
+  (c >= 'a' && c <= 'z') ||
+  (c >= 'A' && c <= 'Z') ||
+  (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
+
+pExpr :: RP.ReadP PGF2.Expr
+pExpr =
+  RP.readS_to_P $ \str ->
+  unsafePerformIO $
+  withText str $ \c_str ->
+  alloca  $ \c_pos ->
+  withForeignPtr unmarshaller $ \u ->
+  mask_ $ do
+    c_expr <- pgf_read_expr_ex c_str c_pos u
+    if c_expr == castPtrToStablePtr nullPtr
+      then return []
+      else do expr <- deRefStablePtr c_expr
+              freeStablePtr c_expr
+              pos <- peek c_pos
+              size <- ((#peek PgfText, size) c_str) :: IO CSize
+              let c_text = castPtr c_str `plusPtr` (#offset PgfText, text)
+              s    <- peekUtf8CString pos (c_text `plusPtr` fromIntegral size)
+              return [(expr,s)]