scmdoc

Automatically generate documentation from comments in R7RS Scheme code

git clone https://git.8pit.net/scmdoc.git

  1-- This parser for Scheme numbers has been copied from Husk Scheme.
  2-- https://github.com/justinethier/husk-scheme/blob/a39da0b385597264d3e5e11c09a907eef3d3db42/hs-src/Language/Scheme/Parser.hs
  3--
  4-- TODO: Write a custom parser for Scheme numbers which is closer to the
  5-- R7RS formal specification provided in section 7.1 (Formal Syntax).
  6--
  7-- Copyright (c) 2010 Justin Ethier
  8--
  9-- Permission is hereby granted, free of charge, to any person obtaining a copy
 10-- of this software and associated documentation files (the "Software"), to deal
 11-- in the Software without restriction, including without limitation the rights
 12-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 13-- copies of the Software, and to permit persons to whom the Software is
 14-- furnished to do so, subject to the following conditions:
 15--
 16-- The above copyright notice and this permission notice shall be included in
 17-- all copies or substantial portions of the Software.
 18--
 19-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 20-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 21-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 22-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 23-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 24-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
 25-- THE SOFTWARE.
 26
 27module SchemeDoc.Parser.Number (number) where
 28
 29import Data.Complex
 30import Data.Ratio
 31import Numeric
 32import SchemeDoc.Types
 33import Text.ParserCombinators.Parsec
 34
 35import qualified Data.Char as DC
 36
 37-- Parse an integer in octal notation, base 8
 38parseOctalNumber :: Parser Sexp
 39parseOctalNumber = do
 40    _ <- try (string "#o")
 41    sign <- many (oneOf "-")
 42    num <- many1 (oneOf "01234567")
 43    case (length sign) of
 44        0 -> return $ Number $ fst $ head (Numeric.readOct num)
 45        1 -> return $ Number $ fromInteger $ (*) (-1) $ fst $ head (Numeric.readOct num)
 46        _ -> pzero
 47
 48-- Parse an integer in binary notation, base 2
 49parseBinaryNumber :: Parser Sexp
 50parseBinaryNumber = do
 51    _ <- try (string "#b")
 52    sign <- many (oneOf "-")
 53    num <- many1 (oneOf "01")
 54    case (length sign) of
 55        0 -> return $ Number $ fst $ head (Numeric.readInt 2 (`elem` "01") DC.digitToInt num)
 56        1 -> return $ Number $ fromInteger $ (*) (-1) $ fst $ head (Numeric.readInt 2 (`elem` "01") DC.digitToInt num)
 57        _ -> pzero
 58
 59-- Parse an integer in hexadecimal notation, base 16
 60parseHexNumber :: Parser Sexp
 61parseHexNumber = do
 62    _ <- try (string "#x")
 63    sign <- many (oneOf "-")
 64    num <- many1 (digit <|> oneOf "abcdefABCDEF")
 65    case (length sign) of
 66        0 -> return $ Number $ fst $ head (Numeric.readHex num)
 67        1 -> return $ Number $ fromInteger $ (*) (-1) $ fst $ head (Numeric.readHex num)
 68        _ -> pzero
 69
 70-- Parser for Integer, base 10
 71parseDecimalNumber :: Parser Sexp
 72parseDecimalNumber = do
 73    _ <- try (many (string "#d"))
 74    sign <- many (oneOf "-")
 75    num <- many1 digit
 76    if (length sign) > 1
 77        then pzero
 78        else return $ (Number . read) $ sign ++ num
 79
 80-- Parser for a base 10 Integer that will also
 81--  check to see if the number is followed by
 82--  an exponent (scientific notation). If so,
 83--  the integer is converted to a float of the
 84--  given magnitude.
 85parseDecimalNumberMaybeExponent :: Parser Sexp
 86parseDecimalNumberMaybeExponent = do
 87    num <- parseDecimalNumber
 88    parseNumberExponent num
 89
 90-- Parse an integer in any base
 91parseNumber :: Parser Sexp
 92parseNumber =
 93    parseDecimalNumberMaybeExponent
 94        <|> parseHexNumber
 95        <|> parseBinaryNumber
 96        <|> parseOctalNumber
 97        <?> "Unable to parse number"
 98
 99-- Parse a floating point number
100parseRealNumber :: Parser Sexp
101parseRealNumber = do
102    sign <- many (oneOf "-+")
103    num <- many digit
104    _ <- char '.'
105    frac <- many1 digit
106    let dec =
107            if not (null num)
108                then num ++ "." ++ frac
109                else "0." ++ frac
110    f <- case (length sign) of
111        0 -> return $ Float $ fst $ head (Numeric.readFloat dec)
112        -- Bit of a hack, but need to support the + sign as well as the minus.
113        1 ->
114            if sign == "-"
115                then return $ Float $ (*) (-1.0) $ fst $ head (Numeric.readFloat dec)
116                else return $ Float $ fst $ head (Numeric.readFloat dec)
117        _ -> pzero
118    parseNumberExponent f
119
120--  Parse the exponent section of a floating point number
121--   in scientific notation. Eg "e10" from "1.0e10"
122parseNumberExponent :: Sexp -> Parser Sexp
123parseNumberExponent n = do
124    expnt <- many $ oneOf "Ee"
125    case (length expnt) of
126        0 -> return n
127        1 -> do
128            num <- try parseDecimalNumber
129            case num of
130                Number nexp -> buildResult n nexp
131                _ -> pzero
132        _ -> pzero
133  where
134    buildResult (Number num) nexp = return $ Float $ (fromIntegral num) * (10 ** (fromIntegral nexp))
135    buildResult (Float num) nexp = return $ Float $ num * (10 ** (fromIntegral nexp))
136    buildResult _ _ = pzero
137
138-- Parse a rational number
139parseRationalNumber :: Parser Sexp
140parseRationalNumber = do
141    pnumerator <- parseDecimalNumber
142    case pnumerator of
143        Number n -> do
144            _ <- char '/'
145            sign <- many (oneOf "-")
146            num <- many1 digit
147            if (length sign) > 1
148                then pzero
149                else do
150                    let pdenominator = read $ sign ++ num
151                    if pdenominator == 0
152                        then return $ Number 0 -- TODO: Prevents a div-by-zero error, but not really correct either
153                        else return $ Rational $ n % pdenominator
154        _ -> pzero
155
156-- Parse a complex number
157parseComplexNumber :: Parser Sexp
158parseComplexNumber = do
159    lispreal <- (try parseRealNumber <|> try parseRationalNumber <|> parseDecimalNumber)
160    let real = case lispreal of
161            Number n -> fromInteger n
162            Rational r -> fromRational r
163            Float f -> f
164            _ -> 0
165    _ <- char '+'
166    lispimag <- (try parseRealNumber <|> try parseRationalNumber <|> parseDecimalNumber)
167    let imag = case lispimag of
168            Number n -> fromInteger n
169            Rational r -> fromRational r
170            Float f -> f
171            _ -> 0 -- Case should never be reached
172    _ <- char 'i'
173    return $ Complex $ real :+ imag
174
175-- Parse a number
176number :: Parser Sexp
177number =
178    try parseComplexNumber
179        <|> try parseRationalNumber
180        <|> try parseRealNumber
181        <|> try parseNumber