adcea86 · elk · git.iko.soy

git.iko.soy/elk

Add parser for numbers

Works on integers like 123, hex numbers like 0xfab, and floats like 6.022e23

commitadcea8681dcc0301b32e0d4bf67609e47571cdc2 authorEvan Czaplicki <evancz@users.noreply.github.com> dateSun 4 Dec 2016, 16:15 (10 years ago) parentf908dc8

2 files changed+249−95

compare with master

unifiedsplit

src/Parse/Literal.hs+19−87 src/Parse/Primitives.hs+230−8

src/Parse/Literal.hs+19−87

@@ -10,7 +10,7 @@ module Parse.Literal (literal) where

1010--import qualified Language.GLSL.Syntax as GLS

1111

1212import qualified AST.Literal as L

13−import Parse.Helpers (Parser, string, character, oneOf)

13+import Parse.Helpers (Parser, string, character, number, oneOf)

1414--import qualified Reporting.Error.Syntax as Error

1515

1616

@@ -28,79 +28,14 @@ literal =

2828

2929

3030

31−-- NUMBERS

32−

33−

34−number :: Parser L.Literal

35−number =

36− error "TODO"

37−

38−

39−{--

40−toLiteral :: String -> L.Literal

41−toLiteral n

42− | 'x' `elem` n = L.IntNum (read n)

43− | any (`elem` ".eE") n = L.FloatNum (read n)

44− | otherwise = L.IntNum (read n)

45−

46−

47−rawNumber :: Parser String

48−rawNumber =

49− concat <$> sequence

50− [ option "" minus

51− , base16 <|> base10

52− ]

53−

54−

55−base16 :: Parser String

56−base16 =

57− do try (string "0x")

58− digits <- many1 hexDigit

59− return ("0x" ++ digits)

60−

61−

62−base10 :: Parser String

63−base10 =

64− concat <$> sequence

65− [ many1 digit

66− , option "" decimals

67− , option "" exponent

68− ]

69−

70−

71−minus :: Parser String

72−minus =

73− try $ do

74− string "-"

75− lookAhead digit

76− return "-"

77−

78−

79−decimals :: Parser String

80−decimals =

81− do try $ lookAhead (string "." >> digit)

82− string "."

83− n <- many1 digit

84− return ('.' : n)

85−

86−

87−exponent :: Parser String

88−exponent =

89− do string "e" <|> string "E"

90− op <- option "" (string "+" <|> string "-")

91− n <- many1 digit

92− return ('e' : op ++ n)

93−

94−

95−

96−-- SHADERS

31+{-- SHADERS

9732

9833

9934shader :: Parser (String, L.GLShaderTipe)

10035shader =

101− do try (string "[glsl|")

36+ do text "[glsl|"

10237 rawSrc <- closeShader id

103− case glSource rawSrc of

38+ case stringToShader rawSrc of

10439 Left err -> parserFail . show $ err

10540 Right tipe -> return (rawSrc, tipe)

10641

@@ -115,18 +50,16 @@ closeShader builder =

11550 ]

11651

11752

118−glSource :: String -> Either ParseError L.GLShaderTipe

119−glSource src =

53+stringToShader :: String -> Either ParseError L.Shader

54+stringToShader src =

12055 case GLP.parse src of

121− Left e -> Left e

56+ Left e ->

57+ Left e

58+

12259 Right (GLS.TranslationUnit decls) ->

123− map extractGLinputs decls

124− |> join

125− |> foldr addGLinput emptyDecls

126− |> Right

60+ Right $ foldr addGLinput emptyDecls $ join $

61+ map extractGLinputs decls

12762 where

128− (|>) = flip ($)

129−

13063 emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty

13164

13265 addGLinput (qual,tipe,name) glDecls =

@@ -156,14 +89,13 @@ glSource src =

15689 False -> []

15790 True ->

15891 case tipe of

159− GLS.Int -> return (qual, L.Int,name)

160− GLS.Float -> return (qual, L.Float,name)

161− GLS.Vec2 -> return (qual, L.V2,name)

162− GLS.Vec3 -> return (qual, L.V3,name)

163− GLS.Vec4 -> return (qual, L.V4,name)

164− GLS.Mat4 -> return (qual, L.M4,name)

165− GLS.Sampler2D -> return (qual, L.Texture,name)

92+ GLS.Vec2 -> return (qual, L.V2, name)

93+ GLS.Vec3 -> return (qual, L.V3, name)

94+ GLS.Vec4 -> return (qual, L.V4, name)

95+ GLS.Mat4 -> return (qual, L.M4, name)

96+ GLS.Int -> return (qual, L.Int, name)

97+ GLS.Float -> return (qual, L.Float, name)

98+ GLS.Sampler2D -> return (qual, L.Texture, name)

16699 _ -> []

167100 _ -> []

168−

169−--}

101+-}

src/Parse/Primitives.hs+230−8

@@ -12,11 +12,13 @@ module Parse.Primitives

1212 , Space(..), whitespace

1313 , docComment

1414 , string, character

15− , digit

15+ , digit, number

1616 )

1717 where

1818

1919import Prelude hiding (length)

20+import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )

21+import Control.Monad

2022import qualified Data.Char as Char

2123import qualified Data.Set as Set

2224import Data.Text (Text)

@@ -28,10 +30,10 @@ import qualified Data.Text.Lazy as LT

2830import qualified Data.Text.Lazy.Builder as LB

2931import Data.Text.Internal.Encoding.Utf16 (chr2)

3032import Data.Text.Internal.Unsafe.Char (unsafeChr)

31−import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )

32−import Control.Monad

33+import GHC.Word (Word16(..))

3334

3435import qualified AST.Helpers as Help (isSymbol)

36+import qualified AST.Literal as L

3537import qualified Reporting.Region as Region

3638

3739

@@ -774,13 +776,16 @@ eatHex array offset length n =

774776character :: Parser Char

775777character =

776778 Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

777− if length <= 3 then

779+ if length == 0 then

778780 eerr (Error row col)

779781

780782 else

781783 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

782784 eerr (Error row col)

783785

786+ else if length < 3 then

787+ cerr (Error row col)

788+

784789 else

785790 case characterHelp array (offset + 1) (length - 1) row (col + 1) of

786791 Left err ->

@@ -826,7 +831,7 @@ characterHelp array offset length row col =

826831

827832

828833

829−-- NUMBERS

834+-- DIGITS

830835

831836

832837digit :: Parser Int

@@ -838,11 +843,228 @@ digit =

838843 else

839844 let

840845 !word = Text.unsafeIndex array offset

841− !isDigit = word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -}

842846 in

843− if isDigit then

847+ if isDigit word then

844848 cok

845849 (fromIntegral (word - 0x0030))

846850 (State array (offset + 1) (length - 1) indent row (col + 1))

847851 else

848− eerr (Error row col)

852+ eerr (Error row col)

853+

854+

855+

856+-- NUMBERS

857+

858+

859+number :: Parser L.Literal

860+number =

861+ Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

862+ if length == 0 then

863+ eerr (Error row col)

864+

865+ else

866+ let

867+ !word = Text.unsafeIndex array offset

868+ in

869+ if not (isDigit word) then

870+ eerr (Error row col)

871+

872+ else

873+ let

874+ chompResults =

875+ if word == 0x0030 {- 0 -} then

876+ chompZero array offset (offset + 1) (length - 1)

877+ else

878+ chompInt array offset (offset + 1) (length - 1)

879+ in

880+ case chompResults of

881+ Left err ->

882+ cerr err

883+

884+ Right (newOffset, newLength, literal) ->

885+ if isDirtyEnd array newOffset newLength then

886+ cerr (Error row col)

887+

888+ else

889+ cok literal (State array newOffset newLength indent row (col + (newOffset - offset)))

890+

891+

892+isDirtyEnd :: Text.Array -> Int -> Int -> Bool

893+isDirtyEnd array offset length =

894+ if length == 0 then

895+ False

896+

897+ else

898+ let

899+ !char = peekChar array offset

900+ in

901+ Char.isAlpha char || char == '_'

902+

903+

904+chompInt :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

905+chompInt array startOffset offset length =

906+ if length == 0 then

907+

908+ Right ( offset, length, readInt array startOffset offset )

909+

910+ else

911+

912+ let

913+ !word = Text.unsafeIndex array offset

914+ in

915+ if isDigit word then

916+ chompInt array startOffset (offset + 1) (length - 1)

917+

918+ else if word == 0x002E {- . -} then

919+ chompFraction array startOffset (offset + 1) (length - 1)

920+

921+ else

922+ Right ( offset, length, readInt array startOffset offset )

923+

924+

925+chompFraction :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

926+chompFraction array startOffset offset length =

927+ if length == 0 then

928+ Left (error "TODO chompFraction")

929+

930+ else if isDigit (Text.unsafeIndex array offset) then

931+ chompFractionHelp array startOffset (offset + 1) (length - 1)

932+

933+ else

934+ Left (error "TODO must be a number after a decimal point")

935+

936+

937+chompFractionHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

938+chompFractionHelp array startOffset offset length =

939+ if length == 0 then

940+ Right (offset, length, readFloat array startOffset offset)

941+

942+ else

943+ let

944+ !word = Text.unsafeIndex array offset

945+ in

946+ if isDigit word then

947+ chompFractionHelp array startOffset (offset + 1) (length - 1)

948+

949+ else if word == 0x0065 {- e -} || word == 0x0045 {- E -} then

950+ chompExponent array startOffset (offset + 1) (length - 1)

951+

952+ else

953+ Right (offset, length, readFloat array startOffset offset)

954+

955+

956+chompExponent :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

957+chompExponent array startOffset offset length =

958+ if length == 0 then

959+ Right (offset, length, readFloat array startOffset offset)

960+

961+ else

962+ let

963+ !word = Text.unsafeIndex array offset

964+ in

965+ if isDigit word then

966+ chompExponentHelp array startOffset (offset + 1) (length - 1)

967+

968+ else if word == 0x002B {- + -} || word == 0x002D {- - -} then

969+

970+ if length > 1 && isDigit (Text.unsafeIndex array (offset + 1)) then

971+ chompExponentHelp array startOffset (offset + 2) (length - 2)

972+ else

973+ Left (error "TODO digits after +/-")

974+

975+ else

976+ Left (error "TODO exponent is messed up")

977+

978+

979+chompExponentHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

980+chompExponentHelp array startOffset offset length =

981+ if length == 0 then

982+ Right (offset, length, readFloat array startOffset offset)

983+

984+ else if isDigit (Text.unsafeIndex array offset) then

985+ chompExponentHelp array startOffset (offset + 1) (length - 1)

986+

987+ else

988+ Right (offset, length, readFloat array startOffset offset)

989+

990+

991+chompZero :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

992+chompZero array startOffset offset length =

993+ if length == 0 then

994+ Right ( offset, length, L.IntNum 0 )

995+

996+ else

997+ let

998+ !word = Text.unsafeIndex array offset

999+ in

1000+ if word == 0x0078 {- x -} then

1001+ chompHex array startOffset (offset + 1) (length - 1)

1002+

1003+ else if word == 0x002E {- . -} then

1004+ chompFraction array startOffset (offset + 1) (length - 1)

1005+

1006+ else if isDigit word then

1007+ Left (error "TODO zero followed by more numbers")

1008+

1009+ else

1010+ Right ( offset, length, L.IntNum 0 )

1011+

1012+

1013+chompHex :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1014+chompHex array startOffset offset length =

1015+ if length == 0 then

1016+ Left (error "TODO need hex digits after 0x")

1017+

1018+ else if isHex (Text.unsafeIndex array offset) then

1019+ chompHexHelp array startOffset (offset + 1) (length - 1)

1020+

1021+ else

1022+ Left (error "TODO need hex digits!")

1023+

1024+

1025+chompHexHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1026+chompHexHelp array startOffset offset length =

1027+ if length == 0 then

1028+ Right ( offset, length, readInt array startOffset offset )

1029+

1030+ else if isHex (Text.unsafeIndex array offset) then

1031+ chompHexHelp array startOffset (offset + 1) (length - 1)

1032+

1033+ else

1034+ Right ( offset, length, readInt array startOffset offset )

1035+

1036+

1037+

1038+-- NUMBER HELPERS

1039+

1040+

1041+{-# INLINE isDigit #-}

1042+isDigit :: Word16 -> Bool

1043+isDigit word =

1044+ word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -}

1045+

1046+

1047+{-# INLINE isHex #-}

1048+isHex :: Word16 -> Bool

1049+isHex word =

1050+ word <= 0x0066 {- f -} && (word >= 0x0061 {- a -} || isDigit word || isCapHex word)

1051+

1052+

1053+{-# INLINE isCapHex #-}

1054+isCapHex :: Word16 -> Bool

1055+isCapHex word =

1056+ word <= 0x0046 {- F -} && word <= 0x0041 {- A -}

1057+

1058+

1059+{-# INLINE readInt #-}

1060+readInt :: Text.Array -> Int -> Int -> L.Literal

1061+readInt array startOffset endOffset =

1062+ L.IntNum $ read $ Text.unpack $

1063+ Text.Text array startOffset (endOffset - startOffset)

1064+

1065+

1066+{-# INLINE readFloat #-}

1067+readFloat :: Text.Array -> Int -> Int -> L.Literal

1068+readFloat array startOffset endOffset =

1069+ L.FloatNum $ read $ Text.unpack $

1070+ Text.Text array startOffset (endOffset - startOffset)