Text/ParserCombinators/ReadPrec.lhs

   1 % ----------------------------------------------------------------
   2 % $Id: ReadPrec.lhs
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module Text.ParserCombinators.ReadPrec
  11   ( ReadPrec      -- :: * -> *; instance Functor, Monad, MonadPlus
  12
  13   -- precedences
  14   , Prec          -- :: *; = Int
  15   , minPrec       -- :: Prec; = 0
  16
  17   -- primitive operations
  18   , lift          -- :: ReadP a -> ReadPrec a
  19   , prec          -- :: Prec -> ReadPrec a -> ReadPrec a
  20   , step          -- :: ReadPrec a -> ReadPrec a
  21   , reset         -- :: ReadPrec a -> ReadPrec a
  22
  23   -- other operations
  24   , get           -- :: ReadPrec Char
  25   , look          -- :: ReadPrec String
  26   , (+++)         -- :: ReadPrec a -> ReadPrec a -> ReadPrec a
  27   , pfail         -- :: ReadPrec a
  28   , choice        -- :: [ReadPrec a] -> ReadPrec a
  29
  30   -- converters
  31   , readPrec_to_P -- :: ReadPrec a       -> (Int -> ReadP a)
  32   , readP_to_Prec -- :: (Int -> ReadP a) -> ReadPrec a
  33   , readPrec_to_S -- :: ReadPrec a       -> (Int -> ReadS a)
  34   , readS_to_Prec -- :: (Int -> ReadS a) -> ReadPrec a
  35   )
  36  where
  37
  38
  39 import Text.ParserCombinators.ReadP
  40   ( ReadP
  41   , readP_to_S
  42   , readS_to_P
  43   )
  44
  45 import qualified Text.ParserCombinators.ReadP as ReadP
  46   ( get
  47   , look
  48   , (+++)
  49   , pfail
  50   , choice
  51   )
  52
  53 import Control.Monad( MonadPlus(..) )
  54 import GHC.Num( Num(..) )
  55 import GHC.Base
  56 \end{code}
  57
  58
  59 %*********************************************************
  60 %*                                                      *
  61 \subsection{The readPrec type}
  62 %*                                                      *
  63 %*********************************************************
  64
  65 \begin{code}
  66 newtype ReadPrec a = P { unP :: Prec -> ReadP a }
  67
  68 -- Functor, Monad, MonadPlus
  69
  70 instance Functor ReadPrec where
  71   fmap h (P f) = P (\n -> fmap h (f n))
  72
  73 instance Monad ReadPrec where
  74   return x  = P (\_ -> return x)
  75   fail s    = P (\_ -> fail s)
  76   P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n)
  77
  78 instance MonadPlus ReadPrec where
  79   mzero = pfail
  80   mplus = (+++)
  81
  82 -- precedences
  83
  84 type Prec = Int
  85
  86 minPrec :: Prec
  87 minPrec = 0
  88 \end{code}
  89
  90
  91 %*********************************************************
  92 %*                                                      *
  93 \subsection{Operations over ReadPrec
  94 %*                                                      *
  95 %*********************************************************
  96
  97 \begin{code}
  98 lift :: ReadP a -> ReadPrec a
  99 lift m = P (\_ -> m)
 100
 101 step :: ReadPrec a -> ReadPrec a
 102 -- Increases the precedence context by one
 103 step (P f) = P (\n -> f (n+1))
 104
 105 reset :: ReadPrec a -> ReadPrec a
 106 -- Resets the precedence context to zero
 107 reset (P f) = P (\n -> f minPrec)
 108
 109 prec :: Prec -> ReadPrec a -> ReadPrec a
 110 -- (prec n p) checks that the precedence context is
 111 --                        less than or equal to n,
 112 --      if not, fails
 113 --      if so, parses p in context n
 114 prec n (P f) = P (\c -> if c <= n then f n else ReadP.pfail)
 115 \end{code}
 116
 117 %*********************************************************
 118 %*                                                      *
 119 \subsection{Derived operations}
 120 %*                                                      *
 121 %*********************************************************
 122
 123 \begin{code}
 124 get :: ReadPrec Char
 125 get = lift ReadP.get
 126
 127 look :: ReadPrec String
 128 look = lift ReadP.look
 129
 130 (+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
 131 P f1 +++ P f2 = P (\n -> f1 n ReadP.+++ f2 n)
 132
 133 pfail :: ReadPrec a
 134 pfail = lift ReadP.pfail
 135
 136 choice :: [ReadPrec a] -> ReadPrec a
 137 choice ps = foldr (+++) pfail ps
 138 \end{code}
 139
 140
 141 %*********************************************************
 142 %*                                                      *
 143 \subsection{Converting between ReadPrec and ReadS
 144 %*                                                      *
 145 %*********************************************************
 146
 147 \begin{code}
 148 -- We define a local version of ReadS here,
 149 -- because its "real" definition site is in GHC.Read
 150 type ReadS a = String -> [(a,String)]
 151
 152 readPrec_to_P :: ReadPrec a -> (Int -> ReadP a)
 153 readPrec_to_P (P f) = f
 154
 155 readP_to_Prec :: (Int -> ReadP a) -> ReadPrec a
 156 readP_to_Prec f = P f
 157
 158 readPrec_to_S :: ReadPrec a -> (Int -> ReadS a)
 159 readPrec_to_S (P f) n = readP_to_S (f n)
 160
 161 readS_to_Prec :: (Int -> ReadS a) -> ReadPrec a
 162 readS_to_Prec f = P (\n -> readS_to_P (f n))
 163 \end{code}