git.iko.soy/elk
on master help sign in
Add parser for numbers
adcea86Evan Czaplicki
src/Parse/Literal.hs+19−87
compare with master
unifiedsplit
@@ -10,7 +10,7 @@ module Parse.Literal (literal) where
10--import qualified Language.GLSL.Syntax as GLS
10--import qualified Language.GLSL.Syntax as GLS
11
11
12import qualified AST.Literal as L
12import qualified AST.Literal as L
13−import Parse.Helpers (Parser, string, character, oneOf)
13+import Parse.Helpers (Parser, string, character, number, oneOf)
14--import qualified Reporting.Error.Syntax as Error
14--import qualified Reporting.Error.Syntax as Error
15
15
16
16
@@ -28,79 +28,14 @@ literal =
28
28
29
29
30
30
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
97
32
98
33
99shader :: Parser (String, L.GLShaderTipe)
34shader :: Parser (String, L.GLShaderTipe)
100shader =
35shader =
101− do try (string "[glsl|")
36+ do text "[glsl|"
102 rawSrc <- closeShader id
37 rawSrc <- closeShader id
103− case glSource rawSrc of
38+ case stringToShader rawSrc of
104 Left err -> parserFail . show $ err
39 Left err -> parserFail . show $ err
105 Right tipe -> return (rawSrc, tipe)
40 Right tipe -> return (rawSrc, tipe)
106
41
@@ -115,18 +50,16 @@ closeShader builder =
115 ]
50 ]
116
51
117
52
118−glSource :: String -> Either ParseError L.GLShaderTipe
53+stringToShader :: String -> Either ParseError L.Shader
119−glSource src =
54+stringToShader src =
120 case GLP.parse src of
55 case GLP.parse src of
121− Left e -> Left e
56+ Left e ->
57+ Left e
58+
122 Right (GLS.TranslationUnit decls) ->
59 Right (GLS.TranslationUnit decls) ->
60+ Right $ foldr addGLinput emptyDecls $ join $
123− map extractGLinputs decls
61+ map extractGLinputs decls
124− |> join
125− |> foldr addGLinput emptyDecls
126− |> Right
127 where
62 where
128− (|>) = flip ($)
129−
130 emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty
63 emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty
131
64
132 addGLinput (qual,tipe,name) glDecls =
65 addGLinput (qual,tipe,name) glDecls =
@@ -156,14 +89,13 @@ glSource src =
156 False -> []
89 False -> []
157 True ->
90 True ->
158 case tipe of
91 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)
92+ GLS.Vec2 -> return (qual, L.V2, name)
162− GLS.Vec3 -> return (qual, L.V3,name)
93+ GLS.Vec3 -> return (qual, L.V3, name)
163− GLS.Vec4 -> return (qual, L.V4,name)
94+ GLS.Vec4 -> return (qual, L.V4, name)
164− GLS.Mat4 -> return (qual, L.M4,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)
165− GLS.Sampler2D -> return (qual, L.Texture,name)
98+ GLS.Sampler2D -> return (qual, L.Texture, name)
166 _ -> []
99 _ -> []
167 _ -> []
100 _ -> []
168−
169−--}
101+-}
src/Parse/Primitives.hs+230−8
@@ -12,11 +12,13 @@ module Parse.Primitives
12 , Space(..), whitespace
12 , Space(..), whitespace
13 , docComment
13 , docComment
14 , string, character
14 , string, character
15− , digit
15+ , digit, number
16 )
16 )
17 where
17 where
18
18
19import Prelude hiding (length)
19import Prelude hiding (length)
20+import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )
21+import Control.Monad
20import qualified Data.Char as Char
22import qualified Data.Char as Char
21import qualified Data.Set as Set
23import qualified Data.Set as Set
22import Data.Text (Text)
24import Data.Text (Text)
@@ -28,10 +30,10 @@ import qualified Data.Text.Lazy as LT
28import qualified Data.Text.Lazy.Builder as LB
30import qualified Data.Text.Lazy.Builder as LB
29import Data.Text.Internal.Encoding.Utf16 (chr2)
31import Data.Text.Internal.Encoding.Utf16 (chr2)
30import Data.Text.Internal.Unsafe.Char (unsafeChr)
32import Data.Text.Internal.Unsafe.Char (unsafeChr)
31−import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )
33+import GHC.Word (Word16(..))
32−import Control.Monad
33
34
34import qualified AST.Helpers as Help (isSymbol)
35import qualified AST.Helpers as Help (isSymbol)
36+import qualified AST.Literal as L
35import qualified Reporting.Region as Region
37import qualified Reporting.Region as Region
36
38
37
39
@@ -774,13 +776,16 @@ eatHex array offset length n =
774character :: Parser Char
776character :: Parser Char
775character =
777character =
776 Parser $ \(State array offset length indent row col) cok cerr _ eerr ->
778 Parser $ \(State array offset length indent row col) cok cerr _ eerr ->
777− if length <= 3 then
779+ if length == 0 then
778 eerr (Error row col)
780 eerr (Error row col)
779
781
780 else
782 else
781 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then
783 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then
782 eerr (Error row col)
784 eerr (Error row col)
783
785
786+ else if length < 3 then
787+ cerr (Error row col)
788+
784 else
789 else
785 case characterHelp array (offset + 1) (length - 1) row (col + 1) of
790 case characterHelp array (offset + 1) (length - 1) row (col + 1) of
786 Left err ->
791 Left err ->
@@ -826,7 +831,7 @@ characterHelp array offset length row col =
826
831
827
832
828
833
829−-- NUMBERS
834+-- DIGITS
830
835
831
836
832digit :: Parser Int
837digit :: Parser Int
@@ -838,11 +843,228 @@ digit =
838 else
843 else
839 let
844 let
840 !word = Text.unsafeIndex array offset
845 !word = Text.unsafeIndex array offset
841− !isDigit = word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -}
842 in
846 in
843− if isDigit then
847+ if isDigit word then
844 cok
848 cok
845 (fromIntegral (word - 0x0030))
849 (fromIntegral (word - 0x0030))
846 (State array (offset + 1) (length - 1) indent row (col + 1))
850 (State array (offset + 1) (length - 1) indent row (col + 1))
847 else
851 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)