diff --git a/package.yaml b/package.yaml index 2afcb10..d669084 100644 --- a/package.yaml +++ b/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 diff --git a/src/Language/Wasm.hs b/src/Language/Wasm.hs index f93a601..3dc8274 100644 --- a/src/Language/Wasm.hs +++ b/src/Language/Wasm.hs @@ -1,4 +1,4 @@ -module ( +module Language.Wasm ( something ) where diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x index d62995c..c84e8b2 100644 --- a/src/Language/Wasm/Lexer.x +++ b/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> "0x" @hexnum { parseHexalUnsignedInt } +<0> $sign? @num { parseDecimalSignedInt } +<0> $sign? "0x" @hexnum { parseHexalSignedInt } <0, blockComment> @startblockcomment { startBlockComment } [.\n] ; @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 -parseHexalUnsignedInt = token $ \(pos, _, s, _) len -> - let num = readHexFromPrefix (fromIntegral len - 2) $ dropChars 2 s in - Lexeme pos $ TUnsignIntLit $ fromIntegral num +parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64) +parseSign str = + let Just (ch, _) = LBSUtf8.decode str in + case ch of + '-' -> (negate, 1) + '+' -> (abs, 1) + otherwise -> (abs, 0) -parseDecimalUnsignedInt :: AlexAction Lexeme -parseDecimalUnsignedInt = token $ \(pos, _, s, _) len -> - let num = readDecFromPrefix (fromIntegral len) $ dropChars 2 s in - Lexeme pos $ TUnsignIntLit $ fromIntegral num +parseHexalSignedInt :: AlexAction Lexeme +parseHexalSignedInt = token $ \(pos, _, s, _) len -> + let (sign, slen) = parseSign s in + 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 - | TSignIntLit Integer + | TIntLit 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 -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 :: Char -> Integer 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] diff --git a/wasm.cabal b/wasm.cabal index 13d5ca3..c73ae0f 100644 --- a/wasm.cabal +++ b/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