Safe Haskell | Safe-Infered |
---|
Language.JavaScript.AST
Contents
Description
In Chapter 2 of "JavaScript: The Good Parts", Douglas Crockford presents a concrete grammar for "the good parts" of JavaScript.
This module provides an abstract grammar for those good parts. Henceforth, we abbreviate this language to JS:TGP
Crockford presents the grammar as a series of railroad diagrams. The correspondence between the concrete grammar and the abstract grammar in this module is NOT one-to-one. However, the following property does hold: the pretty printing of an abstract syntax tree will be parseable by the concrete grammar. i.e. For each valid program produced by the concrete grammar there is a corresponding abstract syntax tree that when pretty printed will produce that program (modulo whitespace).
The abstract grammar
- removes unnecessary characters such as parentheses (normal, curly and square)
- represents JavaScript's string, name and number literals directly in Haskell as
String
,String
andDouble
respectively.
Conventions for concrete syntax
- Non-terminals appear in angle brackets e.g. <JSName>
- ? means zero or one. e.g. <JSExpression>?
- * means zero or more e.g. <JSStatement>*
- + means one or more e.g. <JSStatement>+
- ( ) are meta-brackets used to enclose a concrete-syntax expression so that ?,* or + can be applied. e.g. (= <JSExpression>)* This means zero or more repetitions of: = <JsExpression>
This library was designed so that it would be impossible, save for name, string literals
to construct an incorrect JS:TGP program. To this end some of the data structures may look like
they contain redundancy. For instance, consider the JSESDelete
constructor which is defined
JSESDelete JSExpression JSInvocation
Why not just define it as JSESDelete JSExpression
since type JSExpression
has a constructor defined as JSExpressionInvocation JSExpression JSInvocation
?
The reason is that this would allow incorrect programs. A JSExpression
is
not necessarily a JSInvocation
.
A note on precedence of JavaScript operators
Interestingly, the precedence of JavaScript operators is not defined in the ECMAScript standard. The precedence used in this library comes from the Mozilla Developer's Network pages. (https:developer.mozilla.orgenJavaScriptReferenceOperators/Operator_Precedence)
I have not used the precise precedence numbers from that page since in this module a lower precedence means the operator binds more tightly (as opposed to the page where a higher precedence does the same). Also, we have need for less precedence values so they have been normalised to what we are using in JS:TGP
You will also note that we don't even consider the associativity/precedence of "=", "+=", "-=" etc. In JS:TGP the notion of expression statements is quite different to that of expressions. It simply isn't legal to write an expression statement like
(a += 2) -= 3
or
a = (b = c) = (c = d)
although it is perfectly legal to write
a = b = c = d += 2
which if we add brackets to disambiguate is really
a = (b = (c = (d += 2)))
Interesting aspects of "the good parts":
A JS:TGP program is a collection of statements. You'll note that there is no statement to declare a function in JS:TGP. However you can assign a function literal to a variable.
e.g.
var fun = function(x) { return x + 1;}
What about recursive functions then? There is the option to give the function a name which is local to the literal.
e.g.
var factorial = function f(n) { if ( n > 0 ) { return n * f(n - 1); } else { return 1; } }
f
is local. It will not be in scope outside of the function body.
- data JSString
- data JSName
- unJSString :: JSString -> String
- unJSName :: JSName -> String
- jsString :: String -> Either String JSString
- jsName :: String -> Either String JSName
- newtype JSNumber = JSNumber Double
- data JSVarStatement = JSVarStatement (NonEmptyList JSVarDecl)
- data JSVarDecl = JSVarDecl JSName (Maybe JSExpression)
- data JSStatement
- = JSStatementExpression JSExpressionStatement
- | JSStatementDisruptive JSDisruptiveStatement
- | JSStatementTry JSTryStatement
- | JSStatementIf JSIfStatement
- | JSStatementSwitch (Maybe JSName) JSSwitchStatement
- | JSStatementWhile (Maybe JSName) JSWhileStatement
- | JSStatementFor (Maybe JSName) JSForStatement
- | JSStatementDo (Maybe JSName) JSDoStatement
- data JSDisruptiveStatement
- data JSIfStatement = JSIfStatement JSExpression [JSStatement] (Maybe (Either [JSStatement] JSIfStatement))
- data JSSwitchStatement
- data JSCaseAndDisruptive = JSCaseAndDisruptive JSCaseClause JSDisruptiveStatement
- data JSCaseClause = JSCaseClause JSExpression [JSStatement]
- data JSForStatement
- data JSDoStatement = JSDoStatement [JSStatement] JSExpression
- data JSWhileStatement = JSWhileStatement JSExpression [JSStatement]
- data JSTryStatement = JSTryStatement [JSStatement] JSName [JSStatement]
- data JSThrowStatement = JSThrowStatement JSExpression
- data JSReturnStatement = JSReturnStatement (Maybe JSExpression)
- data JSBreakStatement = JSBreakStatement (Maybe JSName)
- data JSExpressionStatement
- = JSESApply (NonEmptyList JSLValue) JSRValue
- | JSESDelete JSExpression JSRefinement
- data JSLValue = JSLValue JSName [([JSInvocation], JSRefinement)]
- data JSRValue
- = JSRVAssign JSExpression
- | JSRVAddAssign JSExpression
- | JSRVSubAssign JSExpression
- | JSRVInvoke (NonEmptyList JSInvocation)
- data JSExpression
- = JSExpressionLiteral JSLiteral
- | JSExpressionName JSName
- | JSExpressionPrefix JSPrefixOperator JSExpression
- | JSExpressionInfix JSInfixOperator JSExpression JSExpression
- | JSExpressionTernary JSExpression JSExpression JSExpression
- | JSExpressionInvocation JSExpression JSInvocation
- | JSExpressionRefinement JSExpression JSRefinement
- | JSExpressionNew JSExpression JSInvocation
- | JSExpressionDelete JSExpression JSRefinement
- data JSPrefixOperator
- = JSTypeOf
- | JSToNumber
- | JSNegate
- | JSNot
- data JSInfixOperator
- data JSInvocation = JSInvocation [JSExpression]
- data JSRefinement
- data JSLiteral
- data JSObjectLiteral = JSObjectLiteral [JSObjectField]
- data JSObjectField = JSObjectField (Either JSName JSString) JSExpression
- data JSArrayLiteral = JSArrayLiteral [JSExpression]
- data JSFunctionLiteral = JSFunctionLiteral (Maybe JSName) [JSName] JSFunctionBody
- data JSFunctionBody = JSFunctionBody [JSVarStatement] [JSStatement]
- data JSProgram = JSProgram [JSVarStatement] [JSStatement]
Documentation
unJSString :: JSString -> StringSource
jsString :: String -> Either String JSStringSource
The only way you can create a Javascript string. This function needs to correctly encode all special characters. See p9 of "JavaScript: The Good Parts"
Data types
data JSVarStatement Source
Concrete syntax:
var <VarDecl> [, <VarDecl>]* ;
e.g. var x = 1, y;
Constructors
JSVarStatement (NonEmptyList JSVarDecl) |
Instances
Pretty JSVarStatement | |
PrettyPrec JSVarStatement |
Concrete syntax:
<JSName> (= <JSExpression>)?
e.g.
x
x = 2 + y
Constructors
JSVarDecl JSName (Maybe JSExpression) |
data JSStatement Source
The many different kinds of statements
Constructors
JSStatementExpression JSExpressionStatement | <JSExpressionStatement>; |
JSStatementDisruptive JSDisruptiveStatement | <JSDisruptiveStatement> |
JSStatementTry JSTryStatement | <JSTryStatement> |
JSStatementIf JSIfStatement | <JSIfStatement> |
JSStatementSwitch (Maybe JSName) JSSwitchStatement | (<JSName> : ) <JSSwitchStatement> |
JSStatementWhile (Maybe JSName) JSWhileStatement | (<JSName> : ) <JSWhileStatement> |
JSStatementFor (Maybe JSName) JSForStatement | (<JSName> : ) <JSForStatement> |
JSStatementDo (Maybe JSName) JSDoStatement | (<JSName> : ) <JSDoStatement> |
Instances
Pretty JSStatement | |
PrettyPrec JSStatement |
data JSDisruptiveStatement Source
Disruptive statements
Constructors
JSDSBreak JSBreakStatement | <JSBreakStatement> |
JSDSReturn JSReturnStatement | syntax: <JSReturnStatement> |
JSDSThrow JSThrowStatement | syntax: <JSThrowStatement> |
Instances
Pretty JSDisruptiveStatement | |
PrettyPrec JSDisruptiveStatement |
data JSIfStatement Source
Concrete syntax:
if ( <JSExpression> ) { <JSStatement>* }
-- for Nothing
or
if ( <JSExpression> ) { <JSStatement>* } else { <JSStatement>* }
-- for 'Just . Left'
or
if ( <JSExpression> ) { <JSStatement>* } else <JSIfStatement>
-- for 'Just . Right'
e.g.
if (x > 3) { y = 2; }
if (x < 2) { y = 1; } else { y = 3; z = 2; }
if (x > 0) { y = 20; } else if ( x > 10) { y = 30; } else { y = 10; }
Constructors
JSIfStatement JSExpression [JSStatement] (Maybe (Either [JSStatement] JSIfStatement)) |
Instances
Pretty JSIfStatement | |
PrettyPrec JSIfStatement |
data JSSwitchStatement Source
Concrete syntax:
switch ( <JSExpression> ) { <JSCaseClause> }
or
switch ( <JSExpression> ) { <JSCaseAndDisruptive>+ default : <JSStatement>* }
e.g.
switch ( x ) { case 1: y = 2; }
switch ( x ) { case 1: y = 2; break; case 2: y = 3; break; default: y = 4; }
Constructors
JSSwitchStatementSingleCase JSExpression JSCaseClause | |
JSSwitchStatement JSExpression (NonEmptyList JSCaseAndDisruptive) [JSStatement] | default clause statements |
Instances
Pretty JSSwitchStatement | |
PrettyPrec JSSwitchStatement |
data JSCaseAndDisruptive Source
A case clause followed by a disruptive statement
Concrete syntax:
<JSCaseClause> <JSDisruptiveStatement>
e.g.
-
case 2: y = 2; break;
Constructors
JSCaseAndDisruptive JSCaseClause JSDisruptiveStatement |
Instances
Pretty JSCaseAndDisruptive | |
PrettyPrec JSCaseAndDisruptive |
data JSCaseClause Source
Concrete syntax:
case <JSExpression> : <JSStatement>*
e.g.
case 2: // zero statements following the case expression is valid.
case 2: y = 1;
Constructors
JSCaseClause JSExpression [JSStatement] |
Instances
Pretty JSCaseClause | |
PrettyPrec JSCaseClause |
data JSForStatement Source
Two style of for-statements -- C-style and In-style.
Concrete syntax:
for (<JSExpressionStatement>? ; <JSExpression>? ; <JSExpressionStatement>? ) { <JSStatement>* }
for ( <JSName> in <JSExpression> ) { <JSStatement>* }
e.g.
for ( ; ; ) { }
for ( ; x < 10 ;) { x += 1; }
for (i = 0; i < 10; i += 1) { x += i; }
for ( i in indices ) { a[i] = 66; }
Constructors
JSForStatementCStyle (Maybe JSExpressionStatement) (Maybe JSExpression) (Maybe JSExpressionStatement) [JSStatement] | |
JSForStatementInStyle JSName JSExpression [JSStatement] |
Instances
Pretty JSForStatement | |
PrettyPrec JSForStatement |
data JSDoStatement Source
Concrete syntax:
do { <JSStatement>* } while ( <JSExpression> );
Constructors
JSDoStatement [JSStatement] JSExpression |
Instances
Pretty JSDoStatement | |
PrettyPrec JSDoStatement |
data JSWhileStatement Source
Concrete syntax:
while ( <JSExpression>) { <JSStatement>* }
Constructors
JSWhileStatement JSExpression [JSStatement] |
Instances
Pretty JSWhileStatement | |
PrettyPrec JSWhileStatement |
data JSTryStatement Source
Concrete syntax:
try { <JSStatement>* } catch ( <JSName> ) { <JSStatement>* }
Constructors
JSTryStatement [JSStatement] JSName [JSStatement] |
Instances
Pretty JSTryStatement | |
PrettyPrec JSTryStatement |
data JSThrowStatement Source
Concrete syntax:
throw <JSExpression>;
Constructors
JSThrowStatement JSExpression |
Instances
Pretty JSThrowStatement | |
PrettyPrec JSThrowStatement |
data JSReturnStatement Source
Concrete syntax:
return <JSExpression>?;
e.g.
return;
return 2 + x;
Constructors
JSReturnStatement (Maybe JSExpression) |
Instances
Pretty JSReturnStatement | |
PrettyPrec JSReturnStatement |
data JSBreakStatement Source
Concrete syntax:
break <JSName>?;
e.g.
break;
break some_label;
Constructors
JSBreakStatement (Maybe JSName) |
Instances
Pretty JSBreakStatement | |
PrettyPrec JSBreakStatement |
data JSExpressionStatement Source
Concrete syntax:
<JSValue>+ <JSRValue>
or
delete <JSExpression> <JSRefinement>
Constructors
JSESApply (NonEmptyList JSLValue) JSRValue | |
JSESDelete JSExpression JSRefinement |
Instances
Pretty JSExpressionStatement | |
PrettyPrec JSExpressionStatement |
Concrete syntax:
<JSName> (<JSInvocation>* <JSRefinement>)*
e.g.
x
x.field_1
fun().field_1
fun(1)(2)
fun(1)(2).field_1
x.fun_field_1(x+2).fun_field_2(y+3).field_3
Constructors
JSLValue JSName [([JSInvocation], JSRefinement)] |
Concrete syntax:
= <JSExpression>
or
+= <JSExpression>
or
-= <JSExpression>
or
<JSInvocation>+
e.g.
= 2
+= 3
-= (4 + y)
()
(1)
(x,y,z)
Constructors
JSRVAssign JSExpression | |
JSRVAddAssign JSExpression | |
JSRVSubAssign JSExpression | |
JSRVInvoke (NonEmptyList JSInvocation) |
data JSExpression Source
Constructors
JSExpressionLiteral JSLiteral | <JSLiteral> |
JSExpressionName JSName | <JSName> |
JSExpressionPrefix JSPrefixOperator JSExpression | <JSPrefixOperator> <JSExpression> |
JSExpressionInfix JSInfixOperator JSExpression JSExpression | <JSExpression> <JSInfixOperator> <JSExpression> |
JSExpressionTernary JSExpression JSExpression JSExpression | <JSExpression> ? <JSExpression> : <JSExpression> |
JSExpressionInvocation JSExpression JSInvocation | <JSExpression><JSInvocation> |
JSExpressionRefinement JSExpression JSRefinement | <JSExpression><JSRefinement> |
JSExpressionNew JSExpression JSInvocation | new |
JSExpressionDelete JSExpression JSRefinement | delete |
Instances
Pretty JSExpression | |
PrettyPrec JSExpression |
data JSPrefixOperator Source
Constructors
JSTypeOf | typeof |
JSToNumber | + |
JSNegate | - |
JSNot | ! |
Instances
Pretty JSPrefixOperator | |
PrettyPrec JSPrefixOperator |
data JSInfixOperator Source
Instances
Pretty JSInfixOperator | |
PrettyPrec JSInfixOperator |
data JSInvocation Source
Concrete syntax:
<JSExpression>*
e.g.
()
(1)
(x,z,y)
Constructors
JSInvocation [JSExpression] |
Instances
Pretty JSInvocation | |
PrettyPrec JSInvocation |
data JSRefinement Source
Concrete syntax:
.<JSName>
or
[<JSExpression>]
e.g.
.field_1
[i+1]
Constructors
JSProperty JSName | |
JSSubscript JSExpression |
Instances
Pretty JSRefinement | |
PrettyPrec JSRefinement |
Constructors
JSLiteralNumber JSNumber | <JSNumber> |
JSLiteralString JSString | <JSString> |
JSLiteralObject JSObjectLiteral | <JSObjectLiteral> |
JSLiteralArray JSArrayLiteral | <JSArrayLiteral> |
JSLiteralFunction JSFunctionLiteral |
|
data JSObjectLiteral Source
Concrete syntax:
{}
-- no fields
or
{<JSObjectField> (, <JSObjectField> )*}
-- one or more fields
Constructors
JSObjectLiteral [JSObjectField] |
Instances
Pretty JSObjectLiteral | |
PrettyPrec JSObjectLiteral |
data JSObjectField Source
Concrete syntax:
<JSName>: <JSExpression>
-- for Left
or
<JSString>: <JSExpression>
-- for Right
e.g.
x: y + 3
"value": 3 - z
Constructors
JSObjectField (Either JSName JSString) JSExpression |
Instances
Pretty JSObjectField | |
PrettyPrec JSObjectField |
data JSArrayLiteral Source
Concrete syntax:
[]
-- empty array
or
[<JSExpression> (, <JSExpression>*) ]
-- non empty array
Constructors
JSArrayLiteral [JSExpression] |
Instances
Pretty JSArrayLiteral | |
PrettyPrec JSArrayLiteral |
data JSFunctionLiteral Source
Concrete syntax:
function <JSName>? <JSFunctionBody>
Constructors
JSFunctionLiteral (Maybe JSName) [JSName] JSFunctionBody |
Instances
Pretty JSFunctionLiteral | |
PrettyPrec JSFunctionLiteral |
data JSFunctionBody Source
Concrete syntax:
{ <JSVarStatement>+ <JSStatement>+ }
Constructors
JSFunctionBody [JSVarStatement] [JSStatement] |
Instances
Pretty JSFunctionBody | |
PrettyPrec JSFunctionBody |
Programs. All variable statements come first.
Constructors
JSProgram [JSVarStatement] [JSStatement] |