Skip to content

Commit f082ec6

Browse files
committed
Merge JSDeclaration with JSStatement
1 parent 9330863 commit f082ec6

File tree

8 files changed

+12
-47
lines changed

8 files changed

+12
-47
lines changed

language-javascript.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,6 @@ Test-Suite testsuite
7878
, language-javascript
7979

8080
Other-modules: Test.Language.Javascript.ExpressionParser
81-
Test.Language.Javascript.DeclarationParser
8281
Test.Language.Javascript.Lexer
8382
Test.Language.Javascript.LiteralParser
8483
Test.Language.Javascript.Minify

src/Language/JavaScript/Parser.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ module Language.JavaScript.Parser
1717
, JSTryCatch (..)
1818
, JSTryFinally (..)
1919
, JSStatement (..)
20-
, JSDeclaration (..)
2120
, JSSwitchParts (..)
2221
, JSAST(..)
2322

src/Language/JavaScript/Parser/AST.hs

Lines changed: 4 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ module Language.JavaScript.Parser.AST
1010
, JSTryCatch (..)
1111
, JSTryFinally (..)
1212
, JSStatement (..)
13-
, JSDeclaration (..)
1413
, JSBlock (..)
1514
, JSSwitchParts (..)
1615
, JSAST (..)
@@ -45,7 +44,6 @@ data JSAnnot
4544
data JSAST
4645
= JSAstProgram ![JSStatement] !JSAnnot -- ^source elements, tailing whitespace
4746
| JSAstStatement !JSStatement !JSAnnot
48-
| JSAstDeclaration !JSDeclaration !JSAnnot
4947
| JSAstExpression !JSExpression !JSAnnot
5048
| JSAstLiteral !JSExpression !JSAnnot
5149
deriving (Data, Eq, Show, Typeable)
@@ -73,13 +71,10 @@ data JSStatement
7371
| JSSwitch !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSAnnot ![JSSwitchParts] !JSAnnot !JSSemi -- ^switch,lb,expr,rb,caseblock,autosemi
7472
| JSThrow !JSAnnot !JSExpression !JSSemi -- ^throw val autosemi
7573
| JSTry !JSAnnot !JSBlock ![JSTryCatch] !JSTryFinally -- ^try,block,catches,finally
76-
| JSVariable !JSAnnot !(JSCommaList JSExpression) !JSSemi -- ^var|const, decl, autosemi
74+
| JSVariable !JSAnnot !(JSCommaList JSExpression) !JSSemi -- ^var, decl, autosemi
7775
| JSWhile !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSStatement -- ^while,lb,expr,rb,stmt
7876
| JSWith !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSStatement !JSSemi -- ^with,lb,expr,rb,stmt list
79-
deriving (Data, Eq, Show, Typeable)
80-
81-
data JSDeclaration
82-
= JSExport !JSAnnot !(Maybe JSExpression) !JSSemi -- ^export,expr
77+
| JSExport !JSAnnot !(Maybe JSExpression) !JSSemi -- ^export,expr
8378
deriving (Data, Eq, Show, Typeable)
8479

8580
data JSExpression
@@ -245,7 +240,6 @@ data JSCommaTrailingList a
245240
showStripped :: JSAST -> String
246241
showStripped (JSAstProgram xs _) = "JSAstProgram " ++ ss xs
247242
showStripped (JSAstStatement s _) = "JSAstStatement (" ++ ss s ++ ")"
248-
showStripped (JSAstDeclaration s _) = "JSAstDeclaration (" ++ ss s ++ ")"
249243
showStripped (JSAstExpression e _) = "JSAstExpression (" ++ ss e ++ ")"
250244
showStripped (JSAstLiteral s _) = "JSAstLiteral (" ++ ss s ++ ")"
251245

@@ -283,6 +277,8 @@ instance ShowStripped JSStatement where
283277
ss (JSVariable _ xs _as) = "JSVariable " ++ ss xs
284278
ss (JSWhile _ _lb x1 _rb x2) = "JSWhile (" ++ ss x1 ++ ") (" ++ ss x2 ++ ")"
285279
ss (JSWith _ _lb x1 _rb x _) = "JSWith (" ++ ss x1 ++ ") (" ++ ss x ++ ")"
280+
ss (JSExport _ Nothing _) = "JSExport"
281+
ss (JSExport _ (Just x1) _) = "JSExport (" ++ (ss x1) ++ ")"
286282

287283
instance ShowStripped JSExpression where
288284
ss (JSArrayLiteral _lb xs _rb) = "JSArrayLiteral " ++ ss xs
@@ -315,10 +311,6 @@ instance ShowStripped JSExpression where
315311
ss (JSVarInitExpression x1 x2) = "JSVarInitExpression (" ++ ss x1 ++ ") " ++ ss x2
316312
ss (JSSpreadExpression _ x1) = "JSSpreadExpression (" ++ ss x1 ++ ")"
317313

318-
instance ShowStripped JSDeclaration where
319-
ss (JSExport _ Nothing _) = "JSExport"
320-
ss (JSExport _ (Just x1) _) = "JSExport (" ++ (ss x1) ++ ")"
321-
322314
instance ShowStripped JSTryCatch where
323315
ss (JSCatch _ _lb x1 _rb x3) = "JSCatch (" ++ ss x1 ++ "," ++ ss x3 ++ ")"
324316
ss (JSCatchIf _ _lb x1 _ ex _rb x3) = "JSCatch (" ++ ss x1 ++ ") if " ++ ss ex ++ " (" ++ ss x3 ++ ")"

src/Language/JavaScript/Parser/Grammar7.y

Lines changed: 2 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
module Language.JavaScript.Parser.Grammar7
44
( parseProgram
55
, parseStatement
6-
, parseDeclaration
76
, parseExpression
87
, parseLiteral
98
) where
@@ -22,7 +21,6 @@ import qualified Language.JavaScript.Parser.AST as AST
2221
%name parseLiteral LiteralMain
2322
%name parseExpression ExpressionMain
2423
%name parseStatement StatementMain
25-
%name parseDeclaration DeclarationMain
2624

2725
%tokentype { Token }
2826
%error { parseError }
@@ -894,6 +892,7 @@ StatementNoEmpty : StatementBlock { $1 {- 'StatementNoEmpty1' -} }
894892
| ThrowStatement { $1 {- 'StatementNoEmpty13' -} }
895893
| TryStatement { $1 {- 'StatementNoEmpty14' -} }
896894
| DebuggerStatement { $1 {- 'StatementNoEmpty15' -} }
895+
| ExportDeclaration { $1 {- 'StatementNoEmpty16' -} }
897896

898897

899898
StatementBlock :: { AST.JSStatement }
@@ -1152,10 +1151,6 @@ Program :: { AST.JSAST }
11521151
Program : StatementList Eof { AST.JSAstProgram $1 $2 {- 'Program1' -} }
11531152
| Eof { AST.JSAstProgram [] $1 {- 'Program2' -} }
11541153
1155-
1156-
Declaration :: { AST.JSDeclaration }
1157-
Declaration : ExportDeclaration { $1 {- 'Declaration1' -} }
1158-
11591154
-- ExportDeclaration : See 15.2.3
11601155
-- export * FromClause ;
11611156
-- export ExportClause FromClause ;
@@ -1165,7 +1160,7 @@ Declaration : ExportDeclaration { $1 {- 'Declaration1' -} }
11651160
-- export default HoistableDeclaration[Default]
11661161
-- export default ClassDeclaration[Default]
11671162
-- export default [lookahead ∉ { function, class }] AssignmentExpression[In] ;
1168-
ExportDeclaration :: { AST.JSDeclaration }
1163+
ExportDeclaration :: { AST.JSStatement }
11691164
ExportDeclaration : Export ExportClause AutoSemi { AST.JSExport $1 $2 $3 {- 'ExportDeclaration' -} }
11701165
11711166
-- ExportClause :
@@ -1192,9 +1187,6 @@ ExpressionMain : Expression Eof { AST.JSAstExpression $1 $2 {- 'ExpressionMa
11921187
StatementMain :: { AST.JSAST }
11931188
StatementMain : StatementNoEmpty Eof { AST.JSAstStatement $1 $2 {- 'StatementMain' -} }
11941189
1195-
DeclarationMain :: { AST.JSAST }
1196-
DeclarationMain : Declaration Eof { AST.JSAstDeclaration $1 $2 {- 'DeclarationMain' -} }
1197-
11981190
{
11991191
12001192
-- Need this type while build the AST, but is not actually part of the AST.

src/Language/JavaScript/Parser/Lexer.x

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -517,6 +517,7 @@ keywordNames =
517517
, ( "else", ElseToken )
518518
519519
, ( "enum", EnumToken ) -- not a keyword, nominally a future reserved word, but actually in use
520+
, ( "export", ExportToken )
520521
521522
, ( "false", FalseToken ) -- boolean literal
522523
@@ -563,7 +564,6 @@ keywordNames =
563564
-- ( "code", FutureToken ) **** not any more
564565
-- ( "const", FutureToken ) **** an actual token, used in productions
565566
-- enum **** an actual token, used in productions
566-
, ( "export", ExportToken )
567567
, ( "extends", FutureToken )
568568
569569
, ( "import", FutureToken )

test/Test/Language/Javascript/DeclarationParser.hs

Lines changed: 0 additions & 20 deletions
This file was deleted.

test/Test/Language/Javascript/StatementParser.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,11 @@ testStatementParser = describe "Parse statements:" $ do
1616
testStmt "x" `shouldBe` "Right (JSAstStatement (JSIdentifier 'x'))"
1717
testStmt "null" `shouldBe` "Right (JSAstStatement (JSLiteral 'null'))"
1818
testStmt "true?1:2" `shouldBe` "Right (JSAstStatement (JSExpressionTernary (JSLiteral 'true',JSDecimal '1',JSDecimal '2')))"
19+
20+
it "export" $ do
21+
testStmt "export {}" `shouldBe` "Right (JSAstStatement (JSExport))"
22+
testStmt "export {};" `shouldBe` "Right (JSAstStatement (JSExport))"
23+
1924
it "block" $ do
2025
testStmt "{}" `shouldBe` "Right (JSAstStatement (JSStatementBlock []))"
2126
testStmt "{x=1}" `shouldBe` "Right (JSAstStatement (JSStatementBlock [JSOpAssign ('=',JSIdentifier 'x',JSDecimal '1')]))"

test/testsuite.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ import Test.Hspec
55
import Test.Hspec.Runner
66

77

8-
import Test.Language.Javascript.DeclarationParser
98
import Test.Language.Javascript.ExpressionParser
109
import Test.Language.Javascript.Lexer
1110
import Test.Language.Javascript.LiteralParser
@@ -29,7 +28,6 @@ testAll = do
2928
testLiteralParser
3029
testExpressionParser
3130
testStatementParser
32-
testDeclarationParser
3331
testProgramParser
3432
testRoundTrip
3533
testMinifyExpr

0 commit comments

Comments
 (0)