Commits

Bryan O'Sullivan  committed ea68fc1

Switch over to a CPS-based parsing monad

Doesn't actually seem to make a difference to performance :-\

  • Participants
  • Parent commits d286162

Comments (0)

Files changed (1)

File Data/Text/Lex.hs

-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, Rank2Types #-}
 
 -- |
 -- Module      : Data.Text.Lex
 -- to the result of applying the given reader.
 signed :: Num a => Lexer a -> Lexer a
 {-# INLINE signed #-}
-signed f = runP (signa (P f))
+signed f = parse (signa (asP f))
 
 signa :: Num a => Parser a -> Parser a
 {-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
   if sign == '+' then p else negate `liftM` p
 
 newtype Parser a = P {
-      runP :: Text -> Either String (a,Text)
+      runP :: forall r.
+              (String -> Either String (r,Text))
+           -> (a -> Text -> Either String (r,Text))
+           -> Text -> Either String (r,Text)
     }
 
+parse :: Parser a -> Text -> Either String (a,Text)
+parse p t = runP p Left (\a t' -> Right (a,t')) t
+
 instance Monad Parser where
-    return a = P $ \t -> Right (a,t)
+    return a = P $ \kf ks t -> ks a t
     {-# INLINE return #-}
-    m >>= k  = P $ \t -> case runP m t of
-                           Left err     -> Left err
-                           Right (a,t') -> runP (k a) t'
+    m >>= k  = P $ \kf ks t -> runP m kf (\a t' -> runP (k a) kf ks t') t
     {-# INLINE (>>=) #-}
-    fail msg = P $ \_ -> Left msg
+    fail msg = P $ \kf ks t -> kf msg
 
 perhaps :: a -> Parser a -> Parser a
-perhaps def m = P $ \t -> case runP m t of
-                            Left _      -> Right (def,t)
-                            r@(Right _) -> r
+perhaps def m = P $ \kf ks t -> runP m (\_ -> ks def t) ks t
 
 char :: (Char -> Bool) -> Parser Char
-char p = P $ \t -> case T.uncons t of
-                     Just (c,t') | p c -> Right (c,t')
-                     _                 -> Left "char"
+char p = P $ \kf ks t -> case T.uncons t of
+                           Just (c,t') | p c -> ks c t'
+                           _                 -> kf "char"
+
+asP :: (Text -> Either String (a,Text)) -> Parser a
+asP p = P $ \kf ks t -> case p t of
+                          Left err -> kf err
+                          Right (a,t') -> ks a t'
 
 -- | Read a rational number.
 rational :: RealFloat a => Lexer a
 {-# SPECIALIZE rational :: Lexer Double #-}
-rational = runP $ do
-  real <- signa (P decimal)
+rational = parse $ do
+  real <- signa (asP decimal)
   (fraction,fracDigits) <- perhaps (0,0) $ do
     _ <- char (=='.')
-    digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
-    n <- P decimal
+    digits <- P $ \kf ks t -> ks (T.length $ T.takeWhile isDigit t) t
+    n <- asP decimal
     return (n, digits)
-  power <- perhaps 0 (char (`elem` "eE") >> signa (P decimal) :: Parser Int)
+  power <- perhaps 0 (char (`elem` "eE") >> signa (asP decimal) :: Parser Int)
   return $! if fraction == 0
             then if power == 0
                  then fromIntegral real
             else fromRational $ if power == 0
                  then real % 1 + fraction % (10 ^ fracDigits)
                  else (real % 1 + fraction % (10 ^ fracDigits)) * (10 ^^ power)
-