From 10011f6fb22efdf37f8306c11748d2ff1f85de9c Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Thu, 18 Jan 2018 16:07:04 -0800 Subject: [PATCH] initial --- .gitignore | 1 + package.yaml | 46 +++++++ src/Language/Wasm.hs | 6 + src/Language/Wasm/Lexer.x | 268 +++++++++++++++++++++++++++++++++++++ src/Language/Wasm/Parser.y | 0 stack.yaml | 6 + tests/Test.hs | 11 ++ wasm.cabal | 64 +++++++++ 8 files changed, 402 insertions(+) create mode 100644 .gitignore create mode 100644 package.yaml create mode 100644 src/Language/Wasm.hs create mode 100644 src/Language/Wasm/Lexer.x create mode 100644 src/Language/Wasm/Parser.y create mode 100644 stack.yaml create mode 100644 tests/Test.hs create mode 100644 wasm.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c1d9b4c --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.stack-work \ No newline at end of file diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..2afcb10 --- /dev/null +++ b/package.yaml @@ -0,0 +1,46 @@ +name: wasm +version: '0.1.0' +author: Ilya Rezvov +maintainer: rezvov.ilya@gmail.com +license: MIT +extra-source-files: +- README.md +- src/Language/Wasm/Parser.y +- src/Language/Wasm/Lexer.x +build-tools: +- alex >=3.1.3 +- happy >=1.9.4 +dependencies: +- base >=4.6 && <5.0 + +library: + source-dirs: src + ghc-options: + - -Wwarn + - -fwarn-incomplete-patterns + - -fwarn-unused-imports + exposed-modules: + - Language.Wasm.Types + - Language.Wasm.Lexer + - Language.Wasm.Parser + dependencies: + - array >= 0.5 && <0.6 + - text >= 1.1 + - bytestring >= 0.10 + - mtl >= 2.2 && <3.0 + - transformers >= 0.4 && <0.6 + - containers >= 0.5 && <0.6 + - utf8-string >= 1.0 + +tests: + test: + main: Test.hs + source-dirs: tests + dependencies: + - wasm == 0.1.0 + - filepath >=1.3 && <1.5 + - text >=1.1 && <1.3 + - bytestring >=0.10 && <0.11 + - mtl ==2.2.1 + - tasty >=0.7 + - tasty-hunit >=0.4.1 && <0.10 diff --git a/src/Language/Wasm.hs b/src/Language/Wasm.hs new file mode 100644 index 0000000..f93a601 --- /dev/null +++ b/src/Language/Wasm.hs @@ -0,0 +1,6 @@ +module ( + something +) where + +something :: Int +something = 42 diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x new file mode 100644 index 0000000..d62995c --- /dev/null +++ b/src/Language/Wasm/Lexer.x @@ -0,0 +1,268 @@ +{ +module Language.Wasm.Lexer ( + scan, + alexScan +) where + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSChar8 +import qualified Data.Char as Char + +} + +%wrapper "monadUserState-bytestring" + +$digit = [0-9] +$hexdigit = [$digit a-f A-F] +$lower = [a-z] +$upper = [A-Z] +$alpha = [$lower $upper] +$namepunct = [\! \# \$ \% \& \′ \* \+ \− \. \/ \: \< \= \> \? \@ \∖ \^ \_ \` \| \~] +$idchar = [$digit $alpha $namepunct] +$space = [\ \x09 \x0A \x0D] +$linechar = [^ \x09] + +@keyword = $lower $idchar* +@reserved = $idchar+ +@linecomment = ";;" $linechar* \x0A +@startblockcomment = "(;" +@endblockcomment = "(;" +@num = $digit (\_? $digit*) +@hexnum = $hexdigit (\_? $hexdigit*) +@unsignedint = @num | "0x" @hexnum + +tokens :- + +<0> $space ; +<0> @keyword { tokenStr TKeyword } +<0> @linecomment ; +<0> "(" { constToken TOpenBracket } +<0> "(" { constToken TCloseBracket } +<0> @num { parseDecimalUnsignedInt } +<0> "0x" @hexnum { parseHexalUnsignedInt } +<0, blockComment> @startblockcomment { startBlockComment } + [.\n] ; + @endblockcomment { endBlockComment } +<0> \" { startStringLiteral } + \\ $hexdigit $hexdigit { appendDoubleHexChar } + \\t { appendCharToStringLiteral '\x09' } + \\n { appendCharToStringLiteral '\x0A' } + \\r { appendCharToStringLiteral '\x0D' } + \\\" { appendCharToStringLiteral '\x22' } + \\\' { appendCharToStringLiteral '\x27' } + \\\\ { appendCharToStringLiteral '\x5C' } + \\n\{ @hexnum \} { appendHexEscapedChar } + . / {isAllowedStringChar} { appendFromHead } + \" { endStringLiteral } +<0> @reserved { tokenStr TReserved } + +{ + +{- Lexem Helpers -} + +defaultStartCode :: Int +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 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 + +parseDecimalUnsignedInt :: AlexAction Lexeme +parseDecimalUnsignedInt = token $ \(pos, _, s, _) len -> + let num = readDecFromPrefix (fromIntegral len) $ dropChars 2 s in + Lexeme pos $ TUnsignIntLit $ fromIntegral num + +startBlockComment :: AlexAction Lexeme +startBlockComment _inp _len = do + depth <- getLexerCommentDepth + if depth <= 0 + then do + alexSetStartCode blockComment + setLexerCommentDepth 1 + else + setLexerCommentDepth (depth + 1) + alexMonadScan + +endBlockComment :: AlexAction Lexeme +endBlockComment _inp _len = do + depth <- getLexerCommentDepth + if depth == 1 + then do + alexSetStartCode defaultStartCode + setLexerCommentDepth 0 + else + setLexerCommentDepth (depth - 1) + alexMonadScan + +startStringLiteral :: AlexAction Lexeme +startStringLiteral _inp _len = do + alexSetStartCode stringLiteral + setLexerStringFlag True + alexMonadScan + +appendCharToStringLiteral :: Char -> AlexAction Lexeme +appendCharToStringLiteral chr _inp _len = do + addCharToLexerStringValue chr + alexMonadScan + +appendFromHead :: AlexAction Lexeme +appendFromHead (_pos, _rest, inp, _) _len = do + addCharToLexerStringValue $ LBSChar8.head inp + alexMonadScan + +appendDoubleHexChar :: AlexAction Lexeme +appendDoubleHexChar (_pos, _rest, inp, _) _len = do + addCharToLexerStringValue $ Char.chr $ readHexFromPrefix 2 $ dropChars 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 + if code < 0xD800 || (code >= 0xE000 && code < 0x110000) + then do + addCharToLexerStringValue $ Char.chr code + alexMonadScan + else + alexError $ "Character code should be in valid UTF range (code < 0xD800 || (code >= 0xE000 && code < 0x110000)): " ++ show pos + +endStringLiteral :: AlexAction Lexeme +endStringLiteral (pos, _, _inp, _) _len = do + alexSetStartCode defaultStartCode + setLexerStringFlag False + str <- getLexerStringValue + return $ Lexeme pos $ TStringLit str + +tokenStr :: (LBS.ByteString -> Token) -> AlexAction Lexeme +tokenStr f = token $ \(pos, _, s, _) len -> (Lexeme pos $ f $ LBS.take len s) + +constToken :: Token -> AlexAction Lexeme +constToken tok = token $ \(pos, _, _, _) _len -> (Lexeme pos tok) + +{- End Lexem Helpers -} + +data Token = TKeyword LBS.ByteString + | TUnsignIntLit Integer + | TSignIntLit Integer + | TFloatLit Double + | TStringLit LBS.ByteString + | TId LBS.ByteString + | TOpenBracket + | TCloseBracket + | TReserved LBS.ByteString + | EOF + deriving (Show, Eq) + +data Lexeme = Lexeme { pos :: AlexPosn, tok :: Token } deriving (Show, Eq) + +data AlexUserState = AlexUserState { + lexerCommentDepth :: Int, + lexerStringValue :: LBS.ByteString, + lexerIsString :: Bool + } + +alexInitUserState :: AlexUserState +alexInitUserState = AlexUserState { + lexerCommentDepth = 0, + lexerIsString = False, + lexerStringValue = LBS.empty + } + +getLexerCommentDepth :: Alex Int +getLexerCommentDepth = Alex $ \s@AlexState{alex_ust=ust} -> + Right (s, lexerCommentDepth ust) + +setLexerCommentDepth :: Int -> Alex () +setLexerCommentDepth ss = Alex $ \s -> + Right (s{ alex_ust=(alex_ust s){ lexerCommentDepth = ss } }, ()) + +getLexerStringFlag :: Alex Bool +getLexerStringFlag = Alex $ \s@AlexState{alex_ust=ust} -> Right (s, lexerIsString ust) + +setLexerStringFlag :: Bool -> Alex () +setLexerStringFlag isString = Alex $ \s -> + Right (s{ alex_ust=(alex_ust s){ lexerIsString = isString } }, ()) + +getLexerStringValue :: Alex LBS.ByteString +getLexerStringValue = Alex $ \s@AlexState{alex_ust=ust} -> Right (s, lexerStringValue ust) + +setLexerStringValue :: LBS.ByteString -> Alex () +setLexerStringValue ss = Alex $ \s -> + Right (s{ alex_ust=(alex_ust s){ lexerStringValue = ss } }, ()) + +addCharToLexerStringValue :: Char -> Alex () +addCharToLexerStringValue c = Alex $ \s -> + let ust = alex_ust s in + Right (s{ alex_ust = ust{ lexerStringValue = LBSChar8.cons 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 chr = + case chr of + '0' -> 0 + '1' -> 1 + '2' -> 2 + '3' -> 3 + '4' -> 4 + '5' -> 5 + '6' -> 6 + '7' -> 7 + '8' -> 8 + '9' -> 9 + 'A' -> 10 + 'B' -> 11 + 'C' -> 12 + 'D' -> 13 + 'E' -> 14 + 'F' -> 15 + 'a' -> 10 + 'b' -> 11 + 'c' -> 12 + 'd' -> 13 + 'e' -> 14 + 'f' -> 15 + otherwise -> 0 + +readFromPrefix :: Int -> Int -> LBS.ByteString -> Int +readFromPrefix base n bstr + | base <= 16 = + let str = filter (/= '_') $ takeChars n bstr in + let len = length str in + sum $ zipWith (\i c -> readHexFromChar c * (base ^ len - i)) [1..] str + | otherwise = error "base has to be less than or equal 16" + +readHexFromPrefix :: Int -> LBS.ByteString -> Int +readHexFromPrefix = readFromPrefix 16 + +readDecFromPrefix :: Int -> LBS.ByteString -> Int +readDecFromPrefix = readFromPrefix 10 + +scan :: LBS.ByteString -> [Lexeme] +scan = undefined + +} \ No newline at end of file diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y new file mode 100644 index 0000000..e69de29 diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..209987c --- /dev/null +++ b/stack.yaml @@ -0,0 +1,6 @@ +resolver: lts-10.0 +packages: +- '.' +extra-deps: [] +flags: {} +extra-package-dbs: [] diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 index 0000000..eb2f1fd --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,11 @@ +module Main ( + main +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Language.Wasm (something) + +main :: IO () +main = defaultMain $ testGroup "Test Suite" [] diff --git a/wasm.cabal b/wasm.cabal new file mode 100644 index 0000000..13d5ca3 --- /dev/null +++ b/wasm.cabal @@ -0,0 +1,64 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 3022a4b4ff00047ff39872dae4704b089f179ce1286fc792db423160c88b75f8 + +name: wasm +version: 0.1.0 +author: Ilya Rezvov +maintainer: rezvov.ilya@gmail.com +license: MIT +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + src/Language/Wasm/Lexer.x + src/Language/Wasm/Parser.y + +library + hs-source-dirs: + src + ghc-options: -Wwarn -fwarn-incomplete-patterns -fwarn-unused-imports + build-depends: + array >=0.5 && <0.6 + , base >=4.6 && <5.0 + , bytestring >=0.10 + , containers >=0.5 && <0.6 + , mtl >=2.2 && <3.0 + , text >=1.1 + , transformers >=0.4 && <0.6 + , utf8-string >=1.0 + build-tools: + 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 + Paths_wasm + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: + tests + build-depends: + base >=4.6 && <5.0 + , bytestring >=0.10 && <0.11 + , filepath >=1.3 && <1.5 + , mtl ==2.2.1 + , tasty >=0.7 + , tasty-hunit >=0.4.1 && <0.10 + , text >=1.1 && <1.3 + , wasm ==0.1.0 + build-tools: + alex >=3.1.3 + , happy >=1.9.4 + other-modules: + Paths_wasm + default-language: Haskell2010