add integer literal tokenezation

package.yaml

@@ -20,9 +20,8 @@ library:
   - -fwarn-incomplete-patterns
   - -fwarn-unused-imports
   exposed-modules:
-  - Language.Wasm.Types
   - Language.Wasm.Lexer
-  - Language.Wasm.Parser
+  - Language.Wasm
   dependencies:
   - array                >= 0.5  && <0.6
   - text                 >= 1.1

src/Language/Wasm.hs

@@ -1,4 +1,4 @@
-module (
+module Language.Wasm (
     something
 ) where
 

src/Language/Wasm/Lexer.x

@@ -5,8 +5,8 @@ module Language.Wasm.Lexer (
 ) where
 
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy.Char8 as LBSChar8
 import qualified Data.Char as Char
+import qualified Data.ByteString.Lazy.UTF8 as LBSUtf8
 
 }
 
@@ -21,6 +21,7 @@ $namepunct = [\! \# \$ \% \& \′ \* \+ \− \. \/ \: \< \= \> \? \@ \∖ \^ \_
 $idchar    = [$digit $alpha $namepunct]
 $space     = [\  \x09 \x0A \x0D]
 $linechar  = [^ \x09]
+$sign      = [\+ \-]
 
 @keyword     = $lower $idchar*
 @reserved    = $idchar+
@@ -29,7 +30,6 @@ $linechar  = [^ \x09]
 @endblockcomment = "(;"
 @num = $digit (\_? $digit*)
 @hexnum = $hexdigit (\_? $hexdigit*)
-@unsignedint = @num | "0x" @hexnum
 
 tokens :-
 
@@ -38,8 +38,8 @@ tokens :-
 <0> @linecomment                          ;
 <0> "("                                   { constToken TOpenBracket }
 <0> "("                                   { constToken TCloseBracket }
-<0> @num                                  { parseDecimalUnsignedInt }
+<0> $sign? @num                           { parseDecimalSignedInt }
-<0> "0x" @hexnum                          { parseHexalUnsignedInt }
+<0> $sign? "0x" @hexnum                   { parseHexalSignedInt }
 <0, blockComment> @startblockcomment      { startBlockComment }
 <blockComment> [.\n]                      ;
 <blockComment> @endblockcomment           { endBlockComment }
@@ -66,19 +66,29 @@ defaultStartCode = 0
 -- inner string literal character predicate
 isAllowedStringChar :: user -> AlexInput -> Int -> AlexInput -> Bool
 isAllowedStringChar _userState _prevInp _len (_pos, _rest, inp, _) =
-    let char = LBSChar8.head inp in
+    let Just (char, _) = LBSUtf8.decode inp in
     let code = Char.ord char in
     code >= 0x20 && code /= 0x7f && char /= '"' && char /= '\\'
 
-parseHexalUnsignedInt :: AlexAction Lexeme
+parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64)
-parseHexalUnsignedInt = token $ \(pos, _, s, _) len -> 
+parseSign str =
-    let num = readHexFromPrefix (fromIntegral len - 2) $ dropChars 2 s in
+    let Just (ch, _) = LBSUtf8.decode str in
-    Lexeme pos $ TUnsignIntLit $ fromIntegral num
+    case ch of
+        '-' -> (negate, 1)
+        '+' -> (abs, 1)
+        otherwise -> (abs, 0)
 
-parseDecimalUnsignedInt :: AlexAction Lexeme
+parseHexalSignedInt :: AlexAction Lexeme
-parseDecimalUnsignedInt = token $ \(pos, _, s, _) len -> 
+parseHexalSignedInt = token $ \(pos, _, s, _) len -> 
-    let num = readDecFromPrefix (fromIntegral len) $ dropChars 2 s in
+    let (sign, slen) = parseSign s in
-    Lexeme pos $ TUnsignIntLit $ fromIntegral num
+    let num = readHexFromPrefix (len - 2 - slen) $ LBSUtf8.drop (2 + slen) s in
+    Lexeme pos $ TIntLit $ sign num
+
+parseDecimalSignedInt :: AlexAction Lexeme
+parseDecimalSignedInt = token $ \(pos, _, s, _) len ->
+    let (sign, slen) = parseSign s in
+    let num = readDecFromPrefix (len - slen) $ LBSUtf8.drop slen s in
+    Lexeme pos $ TIntLit $ sign num
 
 startBlockComment :: AlexAction Lexeme
 startBlockComment _inp _len = do
@@ -115,22 +125,23 @@ appendCharToStringLiteral chr _inp _len = do
 
 appendFromHead :: AlexAction Lexeme
 appendFromHead (_pos, _rest, inp, _) _len = do
-    addCharToLexerStringValue $ LBSChar8.head inp
+    let Just (first, _) = LBSUtf8.decode inp
+    addCharToLexerStringValue first
     alexMonadScan
 
 appendDoubleHexChar :: AlexAction Lexeme
 appendDoubleHexChar (_pos, _rest, inp, _) _len = do
-    addCharToLexerStringValue $ Char.chr $ readHexFromPrefix 2 $ dropChars 1 inp
+    addCharToLexerStringValue $ Char.chr $ fromIntegral $ readHexFromPrefix 2 $ LBSUtf8.drop 1 inp
     alexMonadScan
 
 -- TODO: add a predicate with code ranges check
 -- if 𝑛 < 0xD800 ∨ 0xE000 ≤ 𝑛 < 0x110000
 appendHexEscapedChar :: AlexAction Lexeme
 appendHexEscapedChar (pos, _rest, inp, _) len = do
-    let code = readHexFromPrefix (fromIntegral len - 3) $ dropChars 2 inp
+    let code = readHexFromPrefix (len - 3) $ LBSUtf8.drop 2 inp
     if code < 0xD800 || (code >= 0xE000 && code < 0x110000)
     then do
-        addCharToLexerStringValue $ Char.chr code
+        addCharToLexerStringValue $ Char.chr $ fromIntegral code
         alexMonadScan
     else
         alexError $ "Character code should be in valid UTF range (code < 0xD800 || (code >= 0xE000 && code < 0x110000)): " ++ show pos
@@ -151,8 +162,7 @@ constToken tok = token $ \(pos, _, _, _) _len -> (Lexeme pos tok)
 {- End Lexem Helpers -}
 
 data Token = TKeyword LBS.ByteString
-    | TUnsignIntLit Integer
+    | TIntLit Integer
-    | TSignIntLit Integer
     | TFloatLit Double
     | TStringLit LBS.ByteString
     | TId LBS.ByteString
@@ -202,26 +212,11 @@ setLexerStringValue ss = Alex $ \s ->
 addCharToLexerStringValue :: Char -> Alex ()
 addCharToLexerStringValue c = Alex $ \s ->
     let ust = alex_ust s in
-    Right (s{ alex_ust = ust{ lexerStringValue = LBSChar8.cons c (lexerStringValue ust) } }, ())
+    Right (s{ alex_ust = ust{ lexerStringValue = LBS.append (LBSUtf8.fromString [c]) (lexerStringValue ust) } }, ())
 
 alexEOF = return $ Lexeme undefined EOF
 
-takeChars :: Int -> LBS.ByteString -> String
+readHexFromChar :: Char -> Integer
-takeChars n str = reverse $ go n str []
-    where
-        go :: Int -> LBS.ByteString -> String -> String
-        go 0 _ acc = acc
-        go n str acc =
-            let Just (ch, rest) = LBSChar8.uncons str in
-            go (n - 1) rest (ch : acc)
-
-dropChars :: Int -> LBS.ByteString -> LBS.ByteString
-dropChars 0 str = str
-dropChars n str =
-    let Just (_, rest) = LBSChar8.uncons str in
-    dropChars (n - 1) rest
-
-readHexFromChar :: Char -> Int
 readHexFromChar chr =
     case chr of 
         '0' -> 0 
@@ -248,18 +243,18 @@ readHexFromChar chr =
         'f' -> 15
         otherwise -> 0
 
-readFromPrefix :: Int -> Int -> LBS.ByteString -> Int
+readFromPrefix :: Int -> Int64 -> LBS.ByteString -> Integer
 readFromPrefix base n bstr
     | base <= 16 =
-        let str = filter (/= '_') $ takeChars n bstr in
+        let str = filter (/= '_') $ LBSUtf8.toString $ LBSUtf8.take n bstr in
         let len = length str in
-        sum $ zipWith (\i c -> readHexFromChar c * (base ^ len - i)) [1..] str
+        sum $ zipWith (\i c -> readHexFromChar c * (fromIntegral base ^ fromIntegral (len - i))) [1..] str
     | otherwise = error "base has to be less than or equal 16"
 
-readHexFromPrefix :: Int -> LBS.ByteString -> Int
+readHexFromPrefix :: Int64 -> LBS.ByteString -> Integer
 readHexFromPrefix = readFromPrefix 16
 
-readDecFromPrefix :: Int -> LBS.ByteString -> Int
+readDecFromPrefix :: Int64 -> LBS.ByteString -> Integer
 readDecFromPrefix = readFromPrefix 10
 
 scan :: LBS.ByteString -> [Lexeme]

wasm.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 3022a4b4ff00047ff39872dae4704b089f179ce1286fc792db423160c88b75f8
+-- hash: 1b02a1858ead3517927e9405dabc17ffb37f0df038564d37e8321b18227389ec
 
 name:           wasm
 version:        0.1.0
@@ -33,12 +33,9 @@ library
       alex >=3.1.3
     , happy >=1.9.4
   exposed-modules:
-      Language.Wasm.Types
       Language.Wasm.Lexer
-      Language.Wasm.Parser
-  other-modules:
       Language.Wasm
-      Language.Wasm.Lexer
+  other-modules:
       Paths_wasm
   default-language: Haskell2010