| 5 | 5 |
module Language.Virgil.Lexer where
|
| 6 | 6 |
|
| 7 | 7 |
import Control.Monad (liftM)
|
| 8 |
import Data.Monoid ((<>))
|
| 9 |
import Data.Scientific
|
| 8 | 10 |
import Data.Text (Text)
|
| 9 | 11 |
import qualified Data.Text as T
|
| 10 | 12 |
|
|
| 16 | 18 |
$digit = 0-9
|
| 17 | 19 |
$alpha = [A-Za-z]
|
| 18 | 20 |
|
| 21 |
@int = $digit+
|
| 22 |
@exp = [Ee] [\-\+]? @int
|
| 23 |
@frac = @int \. @int @exp? | @int @exp
|
| 24 |
@sign = \-?
|
| 25 |
|
| 26 |
@str = \"[^\"]*\"
|
| 27 |
|
| 19 | 28 |
tokens :-
|
| 20 | 29 |
$white+ ;
|
| 21 | 30 |
"#".* ;
|
| 22 | 31 |
|
| 23 | |
$digit+ { lex (TkInt . read . T.unpack) }
|
| 24 | |
\"[^\"]*\" { lex strLiteral } -- this is for syntax highlighting -> "
|
| 32 |
@sign @int \. @int { lex (float True False) }
|
| 33 |
@sign @int \. @int @exp { lex (float True True) }
|
| 34 |
@sign @int @exp { lex (float False True) }
|
| 35 |
|
| 36 |
@sign @int { lex (TkInt . read . T.unpack) }
|
| 37 |
@str { lex strLiteral }
|
| 25 | 38 |
|
| 26 | 39 |
true { lex' (TkKw KwTrue) }
|
| 27 | 40 |
false { lex' (TkKw KwFalse) }
|
|
| 31 | 44 |
\} { lex' TkRCurl }
|
| 32 | 45 |
\[ { lex' TkLBrac }
|
| 33 | 46 |
\] { lex' TkRBrac }
|
| 47 |
\( { lex' TkLParn }
|
| 48 |
\) { lex' TkRParn }
|
| 34 | 49 |
|
| 35 | 50 |
{
|
| 36 | 51 |
data Token = Token AlexPosn TkType deriving (Eq, Show)
|
|
| 43 | 58 |
|
| 44 | 59 |
data TkType
|
| 45 | 60 |
= TkInt Integer
|
| 61 |
| TkFloat Scientific
|
| 46 | 62 |
| TkStr Text
|
| 47 | 63 |
| TkKw KwType
|
| 48 | 64 |
| TkLCurl
|
| 49 | 65 |
| TkRCurl
|
| 50 | 66 |
| TkLBrac
|
| 51 | 67 |
| TkRBrac
|
| 68 |
| TkLParn
|
| 69 |
| TkRParn
|
| 52 | 70 |
| TkEOF
|
| 53 | 71 |
deriving (Eq, Show)
|
| 72 |
|
| 73 |
-- Parsing floats with exponents and whatnot
|
| 74 |
-- XXX: MAKE MORE EFFICIENT AND LESS GROSS
|
| 75 |
float :: Bool -> Bool -> Text -> TkType
|
| 76 |
float False False _ = error "[unreachable]"
|
| 77 |
float True False t = -- dot but not exponent
|
| 78 |
let [a,b] = T.splitOn "." t
|
| 79 |
in TkFloat (scientific (read (T.unpack (a <> b))) (negate (T.length b)))
|
| 80 |
float False True t = -- exponent but no dot
|
| 81 |
let [a,e] = if T.any (== 'e') t
|
| 82 |
then T.splitOn "e" t
|
| 83 |
else T.splitOn "E" t
|
| 84 |
in TkFloat (scientific (read (T.unpack a)) (read (T.unpack e)))
|
| 85 |
float True True t = -- exponent and dot
|
| 86 |
let [t',e] = if T.any (== 'e') t
|
| 87 |
then T.splitOn "e" t
|
| 88 |
else T.splitOn "E" t
|
| 89 |
[a, b] = T.splitOn "." t'
|
| 90 |
in TkFloat (scientific (read (T.unpack (a <> b)))
|
| 91 |
(negate (T.length b) + read (T.unpack e)))
|
| 54 | 92 |
|
| 55 | 93 |
strLiteral :: Text -> TkType
|
| 56 | 94 |
strLiteral = TkStr . T.drop 1 . T.dropEnd 1
|