content: {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
  
  -- | Code for parsing floats. Used both in parsing static code and at runtime
  -- (@INPUT@ and @DATA@ statements).
  
  module Language.VintageBasic.FloatParser(FloatParser(..)) where
  
  import Data.Char(isDigit)
  import Text.ParserCombinators.Parsec
  import Language.VintageBasic.LexCommon(Tagged,getTaggedVal)
  import Language.VintageBasic.Tokenizer(Token(..),tokenP,charTokTest)
  
  -- | Generic class for float parsers. Can be used to parse floats from raw
  -- characters (useful at runtime) or from tokenized text (for parsing source).
  class FloatParser tok st where
      digitP :: GenParser tok st Char
      dotP   :: GenParser tok st Char
      plusP  :: GenParser tok st Char
      minusP :: GenParser tok st Char
      charEP :: GenParser tok st Char
  
      floatP :: GenParser tok st Float
      floatP = do
          sgn <- option "" sgnP
          mant <- try float2P <|> float1P
          expt <- option "" expP
          return (read (sgn++mant++expt))
  
      float1P :: GenParser tok st String
      float1P = many1 digitP
  
      float2P :: GenParser tok st String
      float2P = do
          i <- many digitP
          _ <- dotP
          f <- many digitP
          return ("0"++i++"."++f++"0")
  
      sgnP :: GenParser tok st String
      sgnP = do
          sgn <- plusP <|> minusP
          return (if sgn == '+' then "" else "-")
  
      expP :: GenParser tok st String
      expP = do
          _ <- charEP
          esgn <- option "" sgnP
          i <- many1 digitP
          return ("E"++esgn++i)
  
  instance FloatParser Char st where
      digitP = digit
      dotP   = char '.'
      plusP  = char '+'
      minusP = char '-'
      charEP = char 'E' <|> char 'e'
  
  instance FloatParser (Tagged Token) () where
      digitP = do tok <- tokenP (charTokTest isDigit)
                  return (getCharTokChar $ getTaggedVal tok)
      dotP   = tokenP (==DotTok)            >> return '.'
      plusP  = tokenP (==PlusTok)           >> return '+'
      minusP = tokenP (==MinusTok)          >> return '-'
      charEP = tokenP (charTokTest (=='E')) >> return 'E'
  