initial
This commit is contained in:
Ilya Rezvov
@@ -0,0 +1 @@
|
||||
.stack-work
|
||||
@@ -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
|
||||
@@ -0,0 +1,6 @@
|
||||
module (
|
||||
something
|
||||
) where
|
||||
|
||||
something :: Int
|
||||
something = 42
|
||||
@@ -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 }
|
||||
<blockComment> [.\n] ;
|
||||
<blockComment> @endblockcomment { endBlockComment }
|
||||
<0> \" { startStringLiteral }
|
||||
<stringLiteral> \\ $hexdigit $hexdigit { appendDoubleHexChar }
|
||||
<stringLiteral> \\t { appendCharToStringLiteral '\x09' }
|
||||
<stringLiteral> \\n { appendCharToStringLiteral '\x0A' }
|
||||
<stringLiteral> \\r { appendCharToStringLiteral '\x0D' }
|
||||
<stringLiteral> \\\" { appendCharToStringLiteral '\x22' }
|
||||
<stringLiteral> \\\' { appendCharToStringLiteral '\x27' }
|
||||
<stringLiteral> \\\\ { appendCharToStringLiteral '\x5C' }
|
||||
<stringLiteral> \\n\{ @hexnum \} { appendHexEscapedChar }
|
||||
<stringLiteral> . / {isAllowedStringChar} { appendFromHead }
|
||||
<stringLiteral> \" { 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
|
||||
|
||||
}
|
||||
@@ -0,0 +1,6 @@
|
||||
resolver: lts-10.0
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps: []
|
||||
flags: {}
|
||||
extra-package-dbs: []
|
||||
@@ -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" []
|
||||
+64
@@ -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
|
||||
Reference in New Issue
Block a user